* bug#55338: Symbols with position are sometimes not symbols
@ 2022-05-09 17:25 Paul Eggert
2022-05-10 19:28 ` Alan Mackenzie
0 siblings, 1 reply; 2+ messages in thread
From: Paul Eggert @ 2022-05-09 17:25 UTC (permalink / raw)
To: 55338; +Cc: Alan Mackenzie
[-- Attachment #1: Type: text/plain, Size: 1538 bytes --]
While looking into another issue I saw the code added a few months ago
for symbols with position, and noticed what looked to me to be a bug:
although (read-positioning-symbols "xyz") returns a symbol, (symbolp
(read-positioning-symbols "xyz")) returns nil.
It seems that symbols with positions are symbols only if
symbols-with-pos-enabled is t; otherwise, they are not symbols.
Unfortunately this leads to confusing behavior such as the above.
As I understand it, the symbols-with-pos-enabled variable is present for
performance reasons only. If this understanding is correct, I suggest
removing the variable and having symbols with positions always be
symbols. This would avoid the confusion. I think this could be done
without hurting CPU performance compared to the master branch when
symbols-with-pos-enabled is nil; see attached patch, which is relative
to master commit 6fc54786c3bb797068675d7eb7b500fb990bd04a. (The patch is
incomplete, as src/comp.c would need to be updated to match, but that's
merely turning the crank.)
Even if this patch is completed I have qualms about performance and
correctness of symbols with positions. How about a new build-time flag
--disable-symbols-with-pos that would disable the feature, for people
who don't want performance degraded compared to Emacs 28, or who are
unsure of the correctness implications of the new feature? That should
be easy to add, and I can look into adding it unless there's objection.
Also, there should be a NEWS item about symbols with positions.
[-- Attachment #2: 0001-Always-enable-symbols-with-position.patch --]
[-- Type: text/x-patch, Size: 32836 bytes --]
From d6ab9dcbe18803543d23bd2bc1639fd584dd1b2c Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
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
-#<symbol foo at 12345> 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.
+#<symbol foo at 12345> 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)
-\f
-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 ("#<symbol ", printcharfun);
- if (BARE_SYMBOL_P (sp->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 ("#<overlay ", printcharfun);
if (! XMARKER (OVERLAY_START (obj))->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 ("#<symbol ", printcharfun);
+
Lisp_Object name = SYMBOL_NAME (obj);
ptrdiff_t size_byte = SBYTES (name);
@@ -2211,10 +2190,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
&& !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
print_c_string ("#:", printcharfun);
else if (size_byte == 0)
- {
- print_c_string ("##", printcharfun);
- break;
- }
+ print_c_string ("##", printcharfun);
ptrdiff_t i = 0;
for (ptrdiff_t i_byte = 0; i_byte < size_byte; )
@@ -2239,6 +2215,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar (c, printcharfun);
}
+
+ if (!print_symbols_bare && SYMBOL_HAS_POS (obj))
+ {
+ print_c_string (" at ", printcharfun);
+ print_object (SYMBOL_WITH_POS_POS (obj), printcharfun, escapeflag);
+ printchar ('>', printcharfun);
+ }
}
break;
--
2.35.3
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#55338: Symbols with position are sometimes not symbols
2022-05-09 17:25 bug#55338: Symbols with position are sometimes not symbols Paul Eggert
@ 2022-05-10 19:28 ` Alan Mackenzie
0 siblings, 0 replies; 2+ messages in thread
From: Alan Mackenzie @ 2022-05-10 19:28 UTC (permalink / raw)
To: Paul Eggert; +Cc: acm, 55338
Hello, Paul.
On Mon, May 09, 2022 at 10:25:42 -0700, Paul Eggert wrote:
> While looking into another issue I saw the code added a few months ago
> for symbols with position, and noticed what looked to me to be a bug:
> although (read-positioning-symbols "xyz") returns a symbol, (symbolp
> (read-positioning-symbols "xyz")) returns nil.
Yes. A symbol with position isn't a symbol, any more than a symbol is a
function. But (functionp 'list) returns t, nevertheless. This doesn't
appear to give rise to confusion (except, perhaps, in novices).
> It seems that symbols with positions are symbols only if
> symbols-with-pos-enabled is t; otherwise, they are not symbols.
SWPs are not symbols. They merely give a result of t to symbolp.
> Unfortunately this leads to confusing behavior such as the above.
Why is this any more confusing than functionp returning t for a symbol?
Perhaps the documentation for SWP could be firmed up a bit.
> As I understand it, the symbols-with-pos-enabled variable is present for
> performance reasons only. If this understanding is correct, I suggest
> removing the variable and having symbols with positions always be
> symbols.
This is an interesting idea. It would increase the amount of space used
by Emacs's symbols, though. Would this be important?
> This would avoid the confusion. I think this could be done without
> hurting CPU performance compared to the master branch when
> symbols-with-pos-enabled is nil; see attached patch, which is relative
> to master commit 6fc54786c3bb797068675d7eb7b500fb990bd04a. (The patch
> is incomplete, as src/comp.c would need to be updated to match, but
> that's merely turning the crank.)
So in place of checking symbols-with-pos-enabled at each otherwise
failed EQ operation, we need to check the "real symbol" of each symbol
in such a comparison.
How much faster or slower is, say, a bootstrap build (even without
native compilation) with this proposed scheme? What about benchmarks
which don't involve compilation?
> Even if this patch is completed I have qualms about performance and
> correctness of symbols with positions.
The performance appears to be OK in tests of real world usage, with
perhaps a maximum 1% to 2% slowdown observed. Benchmarking some test
programs showed a greater slowdown. More benchmark results would be
welcome.
As for correctness, the code has been running for several months with
just one or two pertinent bugs found in the byte compiler. They can be,
and have been, corrected. Critically, the bug which gave rise to the
mechanism, wrong line/column numbers being reported in compilation
warning messages, has been fixed.
> How about a new build-time flag --disable-symbols-with-pos that would
> disable the feature, for people who don't want performance degraded
> compared to Emacs 28, or who are unsure of the correctness
> implications of the new feature?
Symbols with position is NOT a user feature. It is (an essential part
of) a bug fix. It seems inappropriate to offer an option not to fix a
bug.
> That should be easy to add, and I can look into adding it unless
> there's objection.
I object. I doubt it would be easy to add, since you'd have to
resuscitate a fair amount of old code discarded from master some while
ago. Maintaining two versions side by side would lead to maintenance
complications.
> Also, there should be a NEWS item about symbols with positions.
No. Again, symbols with position is not a feature, and is not intended
for use outside of the byte compiler. Although I suppose it could be
used if anybody wrote some compiler-like feature for Lisp code, but such
a hacker will know about SWPs without needing to read about them in
NEWS.
[ Patch snipped, but perused. ]
--
Alan Mackenzie (Nuremberg, Germany).
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2022-05-10 19:28 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-05-09 17:25 bug#55338: Symbols with position are sometimes not symbols Paul Eggert
2022-05-10 19:28 ` Alan Mackenzie
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).