From ea69f6354d4eca812475e60e225785e79830806d Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 12 Nov 2018 13:14:18 +0000 Subject: [PATCH] Rename tokens, and tidy up branch after review by Eli Z. New defun position-symbol which creates a symbol with position. * src/lisp.h, src/alloc.c, src/data.c, src/fns.c, src/lread.c, src/print.c: Substitute tokens as follows: build_located_symbol -> build_symbol_with_pos. lisp_h_LOCATED_SYMBOL_P -> lisp_h_SYMBOL_WITH_POS_P. lisp_h_ONLY_SYMBOL_P -> lisp_h_BARE_SYMBOL_P. lisp_h_XLOCATED_SYMBOL -> lisp_h_XSYMBOL_WITH_POS. lisp_h_XONLY_SYMBOL -> lisp_h_XBARE_SYMBOL. Lisp_Located_Symbol -> Lisp_Symbol_With_Pos. located-symbol-loc -> symbol-with-pos-pos. LOCATED_SYMBOL_LOC -> SYMBOL_WITH_POS_POS. located-symbol-p -> symbol-with-pos-p. LOCATED_SYMBOL_P -> SYMBOL_WITH_POS_P. located-symbols-enabled -> symbols-with-pos-enabled. located-symbol-sym -> symbol-with-pos-sym. LOCATED_SYMBOL_SYM -> SYMBOL_WITH_POS_SYM. .loc -> .pos in struct Lisp_Symbol_With_Pos. only-symbol-p -> bare-symbol-p. ONLY_SYMBOL_P -> BARE_SYMBOL_P. PVEC_LOCATED_SYMBOL -> PVEC_SYMBOL_WITH_POS. read-locating-symbols -> read-positioning-symbols. XLOCATED_SYMBOL -> XSYMBOL_WITH_POS. XONLY_SYMBOL -> XBARE_SYMBOL. * src/lisp.h (Lisp_Object, vectorlike_header, pvec_type, More_Lisp_Bits): Restore to their previous positions in the file. (SYMBOLP, XSYMBOL, make_lisp_symbol, builtin_lisp_symbol, CHECK_SYMBOL): Move to after More_Lisp_Bits so that the source will compile. (PSEUDOVECTORP): Invoke the (new) macro lisp_h_PSUEDOVECTORP in place of open coding. * src/data.c (position-symbol): New defun. --- src/alloc.c | 12 +- src/data.c | 73 +++++++---- src/fns.c | 12 +- src/lisp.h | 367 +++++++++++++++++++++++++--------------------------- src/lread.c | 23 ++-- src/print.c | 14 +- 6 files changed, 259 insertions(+), 242 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 7961fc13b91..8c43a468ceb 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3670,17 +3670,17 @@ make_misc_ptr (void *a) return make_lisp_ptr (p, Lisp_Vectorlike); } -/* Return a new located symbol with the specified SYMBOL and LOCATION. */ +/* Return a new symbol with position with the specified SYMBOL and POSITION. */ Lisp_Object -build_located_symbol (Lisp_Object symbol, Lisp_Object location) +build_symbol_with_pos (Lisp_Object symbol, Lisp_Object position) { Lisp_Object val; - struct Lisp_Located_Symbol *p - = (struct Lisp_Located_Symbol *) allocate_vector (2); + struct Lisp_Symbol_With_Pos *p + = (struct Lisp_Symbol_With_Pos *) allocate_vector (2); XSETVECTOR (val, p); - XSETPVECTYPESIZE (XVECTOR (val), PVEC_LOCATED_SYMBOL, 2, 0); + XSETPVECTYPESIZE (XVECTOR (val), PVEC_SYMBOL_WITH_POS, 2, 0); p->sym = symbol; - p->loc = location; + p->pos = position; return val; } diff --git a/src/data.c b/src/data.c index 768d87b6d6c..dee55d44a94 100644 --- a/src/data.c +++ b/src/data.c @@ -228,7 +228,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_NORMAL_VECTOR: return Qvector; case PVEC_BIGNUM: return Qinteger; case PVEC_MARKER: return Qmarker; - case PVEC_LOCATED_SYMBOL: return Qlocated_symbol; + case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; case PVEC_FINALIZER: return Qfinalizer; #ifdef HAVE_MODULES @@ -327,22 +327,22 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, return Qt; } -DEFUN ("only-symbol-p", Fonly_symbol_p, Sonly_symbol_p, 1, 1, 0, - doc: /* Return t if OBJECT is a symbol, but not a located symbol. */ +DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0, + doc: /* Return t if OBJECT is a symbol, but not a symbol together with position. */ attributes: const) (Lisp_Object object) { - if (ONLY_SYMBOL_P (object)) + if (BARE_SYMBOL_P (object)) return Qt; return Qnil; } -DEFUN ("located-symbol-p", Flocated_symbol_p, Slocated_symbol_p, 1, 1, 0, - doc: /* Return t if OBJECT is a located symbol. */ +DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0, + doc: /* Return t if OBJECT is a symbol together with position. */ attributes: const) (Lisp_Object object) { - if (LOCATED_SYMBOL_P (object)) + if (SYMBOL_WITH_POS_P (object)) return Qt; return Qnil; } @@ -772,20 +772,47 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, return name; } -DEFUN ("located-symbol-sym", Flocated_symbol_sym, Slocated_symbol_sym, 1, 1, 0, - doc: /* Return the symbol in a located symbol. */) +DEFUN ("symbol-with-pos-sym", Fsymbol_with_pos_sym, Ssymbol_with_pos_sym, 1, 1, 0, + doc: /* Extract the symbol from a symbol with position. */) (register Lisp_Object ls) { /* Type checking is done in the following macro. */ - return LOCATED_SYMBOL_SYM (ls); + return SYMBOL_WITH_POS_SYM (ls); } -DEFUN ("located-symbol-loc", Flocated_symbol_loc, Slocated_symbol_loc, 1, 1, 0, - doc: /* Return the location in a located symbol. */) +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. */ - return LOCATED_SYMBOL_LOC (ls); + return SYMBOL_WITH_POS_POS (ls); +} + +DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0, + doc: /* Create a new symbol with position. +SYM is a symbol, with or without position, the symbol to position. +POS, the position, is either a fixnum or a symbol with position from which +the position will be taken. */) + (register Lisp_Object sym, register Lisp_Object pos) +{ + Lisp_Object bare; + 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; + else + wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); + + return build_symbol_with_pos (bare, position); } DEFUN ("fset", Ffset, Sfset, 2, 2, 0, @@ -3855,8 +3882,8 @@ syms_of_data (void) DEFSYM (Qlistp, "listp"); DEFSYM (Qconsp, "consp"); - DEFSYM (Qonly_symbol_p, "only-symbol-p"); - DEFSYM (Qlocated_symbol_p, "located-symbol-p"); + DEFSYM (Qbare_symbol_p, "bare-symbol-p"); + DEFSYM (Qsymbol_with_pos_p, "symbol-with-pos-p"); DEFSYM (Qsymbolp, "symbolp"); DEFSYM (Qfixnump, "fixnump"); DEFSYM (Qintegerp, "integerp"); @@ -3884,6 +3911,7 @@ syms_of_data (void) DEFSYM (Qchar_table_p, "char-table-p"); DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p"); + DEFSYM (Qfixnum_or_symbol_with_pos_p, "fixnum-or-symbol-with-pos-p"); DEFSYM (Qsubrp, "subrp"); DEFSYM (Qunevalled, "unevalled"); @@ -3965,7 +3993,7 @@ syms_of_data (void) DEFSYM (Qstring, "string"); DEFSYM (Qcons, "cons"); DEFSYM (Qmarker, "marker"); - DEFSYM (Qlocated_symbol, "located-symbol"); + DEFSYM (Qsymbol_with_pos, "symbol-with-pos"); DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); #ifdef HAVE_MODULES @@ -4013,8 +4041,8 @@ syms_of_data (void) defsubr (&Snumber_or_marker_p); defsubr (&Sfloatp); defsubr (&Snatnump); - defsubr (&Sonly_symbol_p); - defsubr (&Slocated_symbol_p); + defsubr (&Sbare_symbol_p); + defsubr (&Ssymbol_with_pos_p); defsubr (&Ssymbolp); defsubr (&Skeywordp); defsubr (&Sstringp); @@ -4045,8 +4073,9 @@ syms_of_data (void) defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); - defsubr (&Slocated_symbol_sym); - defsubr (&Slocated_symbol_loc); + defsubr (&Ssymbol_with_pos_sym); + defsubr (&Ssymbol_with_pos_pos); + defsubr (&Sposition_symbol); defsubr (&Smakunbound); defsubr (&Sfmakunbound); defsubr (&Sboundp); @@ -4122,10 +4151,10 @@ This variable cannot be set; trying to do so will signal an error. */); Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); - DEFVAR_LISP ("located-symbols-enabled", Vlocated_symbols_enabled, + DEFVAR_LISP ("symbols-with-pos-enabled", Vsymbols_with_pos_enabled, doc: /* Non-nil when "located symbols" can be used in place of symbols. Bind this to non-nil in applications such as the byte compiler. */); - Vlocated_symbols_enabled = Qnil; + Vsymbols_with_pos_enabled = Qnil; DEFSYM (Qwatchers, "watchers"); DEFSYM (Qmakunbound, "makunbound"); diff --git a/src/fns.c b/src/fns.c index d421bc45b12..138cd085680 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2379,12 +2379,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, } } - /* A located symbol compares the contained symbol, and is `equal' to - the corresponding ordinary symbol. */ - if (LOCATED_SYMBOL_P (o1)) - o1 = LOCATED_SYMBOL_SYM (o1); - if (LOCATED_SYMBOL_P (o2)) - o2 = LOCATED_SYMBOL_SYM (o2); + /* 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)) return true; diff --git a/src/lisp.h b/src/lisp.h index b4fc6f24ef9..554307f914f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -323,64 +323,6 @@ typedef union Lisp_X *Lisp_Word; typedef EMACS_INT Lisp_Word; #endif -/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a - Lisp_Word. However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper - around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'. - - LISP_INITIALLY (W) initializes a Lisp object with a tagged value - that is a Lisp_Word W. It can be used in a static initializer. */ - -#ifdef CHECK_LISP_OBJECT_TYPE -typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object; -# define LISP_INITIALLY(w) {w} -# undef CHECK_LISP_OBJECT_TYPE -enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; -#else -typedef Lisp_Word Lisp_Object; -# define LISP_INITIALLY(w) (w) -enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; -#endif - -/* Header of vector-like objects. This documents the layout constraints on - vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents - compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR - and PSEUDOVECTORP cast their pointers to union vectorlike_header *, - because when two such pointers potentially alias, a compiler won't - incorrectly reorder loads and stores to their size fields. See - Bug#8546. This union formerly contained more members, and there's - no compelling reason to change it to a struct merely because the - number of members has been reduced to one. */ -union vectorlike_header - { - /* The main member contains various pieces of information: - - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain - vector (0) or a pseudovector (1). - - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number - of slots) of the vector. - - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: - - a) pseudovector subtype held in PVEC_TYPE_MASK field; - - b) number of Lisp_Objects slots at the beginning of the object - held in PSEUDOVECTOR_SIZE_MASK field. These objects are always - traced by the GC; - - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and - measured in word_size units. Rest fields may also include - Lisp_Objects, but these objects usually needs some special treatment - during GC. - There are some exceptions. For PVEC_FREE, b) is always zero. For - PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. - Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, - 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ - ptrdiff_t size; - }; - -struct Lisp_Located_Symbol - { - union vectorlike_header header; - Lisp_Object sym; /* A symbol */ - Lisp_Object loc; /* A fixnum */ - } GCALIGNED_STRUCT; - /* Some operations are so commonly executed that they are implemented as macros, not functions, because otherwise runtime performance would suffer too much when compiling with GCC without optimization. @@ -437,97 +379,12 @@ struct Lisp_Located_Symbol # endif #endif -/* In the size word of a vector, this bit means the vector has been marked. */ - -DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG) -# define ARRAY_MARK_FLAG PTRDIFF_MIN -DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG) - -/* In the size word of a struct Lisp_Vector, this bit means it's really - some other vector-like object. */ -DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG) -# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2) -DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) - -/* In a pseudovector, the size field actually contains a word with one - PSEUDOVECTOR_FLAG bit set, and one of the following values extracted - with PVEC_TYPE_MASK to indicate the actual type. */ -enum pvec_type -{ - PVEC_NORMAL_VECTOR, - PVEC_FREE, - PVEC_BIGNUM, - PVEC_MARKER, - PVEC_OVERLAY, - PVEC_FINALIZER, - PVEC_LOCATED_SYMBOL, - PVEC_MISC_PTR, -#ifdef HAVE_MODULES - PVEC_USER_PTR, -#endif - PVEC_PROCESS, - PVEC_FRAME, - PVEC_WINDOW, - PVEC_BOOL_VECTOR, - PVEC_BUFFER, - PVEC_HASH_TABLE, - PVEC_TERMINAL, - PVEC_WINDOW_CONFIGURATION, - PVEC_SUBR, - PVEC_OTHER, /* Should never be visible to Elisp code. */ - PVEC_XWIDGET, - PVEC_XWIDGET_VIEW, - PVEC_THREAD, - PVEC_MUTEX, - PVEC_CONDVAR, - PVEC_MODULE_FUNCTION, - - /* These should be last, check internal_equal to see why. */ - PVEC_COMPILED, - PVEC_CHAR_TABLE, - PVEC_SUB_CHAR_TABLE, - PVEC_RECORD, - PVEC_FONT /* Should be last because it's used for range checking. */ -}; - -enum More_Lisp_Bits - { - /* For convenience, we also store the number of elements in these bits. - Note that this size is not necessarily the memory-footprint size, but - only the number of Lisp_Object fields (that need to be traced by GC). - The distinction is used, e.g., by Lisp_Process, which places extra - non-Lisp_Object fields at the end of the structure. */ - PSEUDOVECTOR_SIZE_BITS = 12, - PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1, - - /* To calculate the memory footprint of the pseudovector, it's useful - to store the size of non-Lisp area in word_size units here. */ - PSEUDOVECTOR_REST_BITS = 12, - PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1) - << PSEUDOVECTOR_SIZE_BITS), - - /* Used to extract pseudovector subtype information. */ - PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS, - PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS - }; - #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)))) - -/* These functions extract various sorts of values from a Lisp_Object. - For example, if tem is a Lisp_Object whose type is Lisp_Cons, - XCONS (tem) is the struct Lisp_Cons * pointing to the memory for - that cons. */ - -/* Largest and smallest representable fixnum values. These are the C - 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) - #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) \ @@ -548,11 +405,11 @@ enum More_Lisp_Bits #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_LOCATED_SYMBOL_P(x) lisp_h_PSEUDOVECTORP (XIL(x), PVEC_LOCATED_SYMBOL) -#define lisp_h_ONLY_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_SYMBOL_WITH_POS_P(x) lisp_h_PSEUDOVECTORP (XIL(x), PVEC_SYMBOL_WITH_POS) +#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) /* verify (NIL_IS_ZERO) */ -#define lisp_h_SYMBOLP(x) ((lisp_h_ONLY_SYMBOL_P (x) || \ - (Vlocated_symbols_enabled && (lisp_h_LOCATED_SYMBOL_P (x))))) +#define lisp_h_SYMBOLP(x) ((lisp_h_BARE_SYMBOL_P (x) || \ + (Vsymbols_with_pos_enabled && (lisp_h_SYMBOL_WITH_POS_P (x))))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -572,30 +429,30 @@ enum More_Lisp_Bits # define lisp_h_XFIXNAT(a) XFIXNUM (a) # define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS) # ifdef __CHKP__ -# define lisp_h_XONLY_SYMBOL(a) \ - (eassert (ONLY_SYMBOL_P (a)), \ +# define lisp_h_XBARE_SYMBOL(a) \ + (eassert (BARE_SYMBOL_P (a)), \ (struct Lisp_Symbol *) ((char *) XUNTAG (a, Lisp_Symbol, \ struct Lisp_Symbol) \ + (intptr_t) lispsym)) # else /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7. */ -# define lisp_h_XONLY_SYMBOL(a) \ - (eassert (ONLY_SYMBOL_P (a)), \ +# define lisp_h_XBARE_SYMBOL(a) \ + (eassert (BARE_SYMBOL_P (a)), \ (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \ + (char *) lispsym)) # endif -# define lisp_h_XLOCATED_SYMBOL(a) \ - (eassert (LOCATED_SYMBOL_P (a)), \ - (struct Lisp_Located_Symbol *) XUNTAG \ - (a, Lisp_Vectorlike, struct Lisp_Located_Symbol)) +# define lisp_h_XSYMBOL_WITH_POS(a) \ + (eassert (SYMBOL_WITH_POS_P (a)), \ + (struct Lisp_Symbol_With_Pos *) XUNTAG \ + (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos)) /* verify (NIL_IS_ZERO) */ # define lisp_h_XSYMBOL(a) \ (eassert (SYMBOLP (a)), \ - (!Vlocated_symbols_enabled \ - ? (lisp_h_XONLY_SYMBOL (a)) \ - : (lisp_h_ONLY_SYMBOL_P (a)) \ - ? (lisp_h_XONLY_SYMBOL (a)) \ - : lisp_h_XONLY_SYMBOL (lisp_h_XLOCATED_SYMBOL (a)->sym))) + (!Vsymbols_with_pos_enabled \ + ? (lisp_h_XBARE_SYMBOL (a)) \ + : (lisp_h_BARE_SYMBOL_P (a)) \ + ? (lisp_h_XBARE_SYMBOL (a)) \ + : lisp_h_XBARE_SYMBOL (lisp_h_XSYMBOL_WITH_POS (a)->sym))) # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) #endif @@ -628,7 +485,7 @@ enum More_Lisp_Bits # 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 ONLY_SYMBOL_P(x) lisp_h_ONLY_SYMBOL_P (x) +# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x) # define SYMBOLP(x) lisp_h_SYMBOLP (x) # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) @@ -643,7 +500,7 @@ enum More_Lisp_Bits # define make_fixnum(n) lisp_h_make_fixnum (n) # define XFIXNAT(a) lisp_h_XFIXNAT (a) # define XFIXNUM(a) lisp_h_XFIXNUM (a) -# define XONLY_SYMBOL(a) lisp_h_XONLY_SYMBOL (a) +# define XBARE_SYMBOL(a) lisp_h_XONLY_SYMBOL (a) # define XSYMBOL(a) lisp_h_XSYMBOL (a) # define XTYPE(a) lisp_h_XTYPE (a) # endif @@ -753,6 +610,23 @@ enum Lisp_Fwd_Type You also need to add the new type to the constant `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */ +/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a + Lisp_Word. However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper + around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'. + + LISP_INITIALLY (W) initializes a Lisp object with a tagged value + that is a Lisp_Word W. It can be used in a static initializer. */ + +#ifdef CHECK_LISP_OBJECT_TYPE +typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object; +# define LISP_INITIALLY(w) {w} +# undef CHECK_LISP_OBJECT_TYPE +enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; +#else +typedef Lisp_Word Lisp_Object; +# define LISP_INITIALLY(w) (w) +enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; +#endif /* Forward declarations. */ @@ -771,7 +645,7 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object); -extern Lisp_Object Vlocated_symbols_enabled; +extern Lisp_Object Vsymbols_with_pos_enabled; #ifdef CANNOT_DUMP enum { might_dump = false }; @@ -1014,10 +888,134 @@ typedef EMACS_UINT Lisp_Word_tag; #include "globals.h" +/* Header of vector-like objects. This documents the layout constraints on + vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to union vectorlike_header *, + because when two such pointers potentially alias, a compiler won't + incorrectly reorder loads and stores to their size fields. See + Bug#8546. This union formerly contained more members, and there's + no compelling reason to change it to a struct merely because the + number of members has been reduced to one. */ +union vectorlike_header + { + /* The main member contains various pieces of information: + - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. + - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain + vector (0) or a pseudovector (1). + - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number + of slots) of the vector. + - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: + - a) pseudovector subtype held in PVEC_TYPE_MASK field; + - b) number of Lisp_Objects slots at the beginning of the object + held in PSEUDOVECTOR_SIZE_MASK field. These objects are always + traced by the GC; + - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and + measured in word_size units. Rest fields may also include + Lisp_Objects, but these objects usually needs some special treatment + during GC. + There are some exceptions. For PVEC_FREE, b) is always zero. For + PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. + Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, + 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ + ptrdiff_t size; + }; + +struct Lisp_Symbol_With_Pos + { + union vectorlike_header header; + Lisp_Object sym; /* A symbol */ + Lisp_Object pos; /* A fixnum */ + } GCALIGNED_STRUCT; + +/* In the size word of a vector, this bit means the vector has been marked. */ + +DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG) +# define ARRAY_MARK_FLAG PTRDIFF_MIN +DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG) + +/* In the size word of a struct Lisp_Vector, this bit means it's really + some other vector-like object. */ +DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG) +# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2) +DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) + +/* In a pseudovector, the size field actually contains a word with one + PSEUDOVECTOR_FLAG bit set, and one of the following values extracted + with PVEC_TYPE_MASK to indicate the actual type. */ +enum pvec_type +{ + PVEC_NORMAL_VECTOR, + PVEC_FREE, + PVEC_BIGNUM, + PVEC_MARKER, + PVEC_OVERLAY, + PVEC_FINALIZER, + PVEC_SYMBOL_WITH_POS, + PVEC_MISC_PTR, +#ifdef HAVE_MODULES + PVEC_USER_PTR, +#endif + PVEC_PROCESS, + PVEC_FRAME, + PVEC_WINDOW, + PVEC_BOOL_VECTOR, + PVEC_BUFFER, + PVEC_HASH_TABLE, + PVEC_TERMINAL, + PVEC_WINDOW_CONFIGURATION, + PVEC_SUBR, + PVEC_OTHER, /* Should never be visible to Elisp code. */ + PVEC_XWIDGET, + PVEC_XWIDGET_VIEW, + PVEC_THREAD, + PVEC_MUTEX, + PVEC_CONDVAR, + PVEC_MODULE_FUNCTION, + + /* These should be last, check internal_equal to see why. */ + PVEC_COMPILED, + PVEC_CHAR_TABLE, + PVEC_SUB_CHAR_TABLE, + PVEC_RECORD, + PVEC_FONT /* Should be last because it's used for range checking. */ +}; + +enum More_Lisp_Bits + { + /* For convenience, we also store the number of elements in these bits. + Note that this size is not necessarily the memory-footprint size, but + only the number of Lisp_Object fields (that need to be traced by GC). + The distinction is used, e.g., by Lisp_Process, which places extra + non-Lisp_Object fields at the end of the structure. */ + PSEUDOVECTOR_SIZE_BITS = 12, + PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1, + + /* To calculate the memory footprint of the pseudovector, it's useful + to store the size of non-Lisp area in word_size units here. */ + PSEUDOVECTOR_REST_BITS = 12, + PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1) + << PSEUDOVECTOR_SIZE_BITS), + + /* Used to extract pseudovector subtype information. */ + PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS, + PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS + }; + +/* These functions extract various sorts of values from a Lisp_Object. + For example, if tem is a Lisp_Object whose type is Lisp_Cons, + XCONS (tem) is the struct Lisp_Cons * pointing to the memory for + that cons. */ + +/* Largest and smallest representable fixnum values. These are the C + 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 -(LOCATED_SYMBOL_P) (Lisp_Object x) +(SYMBOL_WITH_POS_P) (Lisp_Object x) { - return lisp_h_LOCATED_SYMBOL_P (x); + return lisp_h_SYMBOL_WITH_POS_P (x); } INLINE bool @@ -1077,7 +1075,6 @@ INLINE void lisp_h_CHECK_SYMBOL (x); } - #if USE_LSB_TAG INLINE Lisp_Object @@ -1627,20 +1624,10 @@ PSEUDOVECTOR_TYPEP (union vectorlike_header *a, enum pvec_type code) == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); } -/* FIXME!!! 2018-11-09. Consider using lisp_h_PSEUDOVECTOR here. */ -/* 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); - } + return lisp_h_PSEUDOVECTORP (a, code); } /* A boolvector is a kind of vectorlike, with contents like a string. */ @@ -2522,27 +2509,27 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } -INLINE struct Lisp_Located_Symbol * -XLOCATED_SYMBOL (Lisp_Object a) +INLINE struct Lisp_Symbol_With_Pos * +XSYMBOL_WITH_POS (Lisp_Object a) { - eassert (LOCATED_SYMBOL_P (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Located_Symbol); + eassert (SYMBOL_WITH_POS_P (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } INLINE Lisp_Object -LOCATED_SYMBOL_SYM (Lisp_Object a) +SYMBOL_WITH_POS_SYM (Lisp_Object a) { - if (!LOCATED_SYMBOL_P (a)) - wrong_type_argument (Qlocated_symbol_p, a); - return XLOCATED_SYMBOL (a)->sym; + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->sym; } INLINE Lisp_Object -LOCATED_SYMBOL_LOC (Lisp_Object a) +SYMBOL_WITH_POS_POS (Lisp_Object a) { - if (!LOCATED_SYMBOL_P (a)) - wrong_type_argument (Qlocated_symbol_p, a); - return XLOCATED_SYMBOL (a)->loc; + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->pos; } #ifdef HAVE_MODULES @@ -3819,7 +3806,7 @@ extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object build_located_symbol (Lisp_Object, Lisp_Object); +extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); diff --git a/src/lread.c b/src/lread.c index 3490d83ecaf..9cfeac81326 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2220,10 +2220,10 @@ STREAM or the value of `standard-input' may be: return read_internal_start (stream, Qnil, Qnil, false); } -DEFUN ("read-locating-symbols", Fread_locating_symbols, - Sread_locating_symbols, 0, 1, 0, +DEFUN ("read-positiong-symbols", Fread_positioning_symbols, + Sread_positioning_symbols, 0, 1, 0, doc: /* Read one Lisp expression as text from STREAM, return as Lisp object. -Convert each occurrence of a symbol into a "located symbol" object. +Convert each occurrence of a symbol into a "symbol with pos" object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: @@ -2267,8 +2267,8 @@ the end of STRING. */) /* Function to set up the global context we need in toplevel read calls. START and END only used when STREAM is a string. - LOCATE_SYMS true means read symbol occurrences as located - symbols. */ + LOCATE_SYMS true means read symbol occurrences as symbols with + position. */ static Lisp_Object read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, bool locate_syms) @@ -2768,7 +2768,8 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix) zero in *PCH and we read and return one lisp object. FIRST_IN_LIST is true if this is the first element of a list. - LOCATE_SYMS true means read symbol occurrences as located symbols. */ + LOCATE_SYMS true means read symbol occurrences as symbols with + position. */ static Lisp_Object read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) @@ -3619,8 +3620,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) } } if (locate_syms) - result = build_located_symbol (result, - make_fixnum (start_position)); + result = build_symbol_with_pos (result, + make_fixnum (start_position)); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) @@ -3959,8 +3960,8 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag, bool locate_syms) } /* FLAG means check for ']' to terminate rather than ')' and '.'. - LOCATE_SYMS true means read symbol occurrencess as located - symbols. */ + LOCATE_SYMS true means read symbol occurrencess as symbols with + position. */ static Lisp_Object read_list (bool flag, Lisp_Object readcharfun, bool locate_syms) @@ -4845,7 +4846,7 @@ void syms_of_lread (void) { defsubr (&Sread); - defsubr (&Sread_locating_symbols); + defsubr (&Sread_positioning_symbols); defsubr (&Sread_from_string); defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); diff --git a/src/print.c b/src/print.c index d1388062a12..f4f95bbb5e0 100644 --- a/src/print.c +++ b/src/print.c @@ -1394,21 +1394,21 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, printchar ('>', printcharfun); break; - case PVEC_LOCATED_SYMBOL: + case PVEC_SYMBOL_WITH_POS: { - struct Lisp_Located_Symbol *ls = XLOCATED_SYMBOL (obj); + struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj); print_c_string ("#sym)) - print_object (ls->sym, printcharfun, escapeflag); + if (BARE_SYMBOL_P (sp->sym)) + print_object (sp->sym, printcharfun, escapeflag); else print_c_string ("NOT A SYMBOL!!", printcharfun); - if (FIXNUMP (ls->loc)) + if (FIXNUMP (sp->pos)) { print_c_string (" at ", printcharfun); - print_object (ls->loc, printcharfun, escapeflag); + print_object (sp->pos, printcharfun, escapeflag); } else - print_c_string (" NOT A LOCATION!!", printcharfun); + print_c_string (" NOT A POSITION!!", printcharfun); printchar ('>', printcharfun); } break; -- 2.39.5