lisp.h 158 KB
Newer Older
1
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1987, 1993-1995, 1997-2019 Free Software Foundation,
4
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

Kenichi Handa's avatar
Kenichi Handa committed
21 22 23
#ifndef EMACS_LISP_H
#define EMACS_LISP_H

Paul Eggert's avatar
Paul Eggert committed
24
#include <alloca.h>
25
#include <setjmp.h>
26
#include <stdalign.h>
27
#include <stdarg.h>
28
#include <stddef.h>
Paul Eggert's avatar
Paul Eggert committed
29
#include <string.h>
30
#include <float.h>
31
#include <inttypes.h>
32
#include <limits.h>
33

34
#include <intprops.h>
Paul Eggert's avatar
Paul Eggert committed
35
#include <verify.h>
36

37 38
INLINE_HEADER_BEGIN

39 40 41
/* Define a TYPE constant ID as an externally visible name.  Use like this:

      DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
42
      # define ID (some integer preprocessor expression of type TYPE)
43 44 45
      DEFINE_GDB_SYMBOL_END (ID)

   This hack is for the benefit of compilers that do not make macro
46 47
   definitions or enums visible to the debugger.  It's used for symbols
   that .gdbinit needs.  */
48

49
#define DECLARE_GDB_SYM(type, id) type const id EXTERNALLY_VISIBLE
50
#ifdef MAIN_PROGRAM
51
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) DECLARE_GDB_SYM (type, id)
52 53
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
54 55
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(val) ;
56 57
#endif

58 59 60 61 62
/* The ubiquitous max and min macros.  */
#undef min
#undef max
#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))
63

64 65
/* Number of elements in an array.  */
#define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0])
66

Paul Eggert's avatar
Paul Eggert committed
67 68 69 70 71
/* Number of bits in a Lisp_Object tag.  */
DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
#define GCTYPEBITS 3
DEFINE_GDB_SYMBOL_END (GCTYPEBITS)

Paul Eggert's avatar
Paul Eggert committed
72
/* EMACS_INT - signed integer wide enough to hold an Emacs value
73
   EMACS_INT_WIDTH - width in bits of EMACS_INT
Paul Eggert's avatar
Paul Eggert committed
74 75 76
   EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
   pI - printf length modifier for EMACS_INT
   EMACS_UINT - unsigned variant of EMACS_INT */
77
#ifndef EMACS_INT_MAX
78 79
# if INTPTR_MAX <= 0
#  error "INTPTR_MAX misconfigured"
Paul Eggert's avatar
Paul Eggert committed
80
# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
81 82
typedef int EMACS_INT;
typedef unsigned int EMACS_UINT;
83
enum { EMACS_INT_WIDTH = INT_WIDTH, EMACS_UINT_WIDTH = UINT_WIDTH };
84 85
#  define EMACS_INT_MAX INT_MAX
#  define pI ""
Paul Eggert's avatar
Paul Eggert committed
86
# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
87
typedef long int EMACS_INT;
88
typedef unsigned long EMACS_UINT;
89
enum { EMACS_INT_WIDTH = LONG_WIDTH, EMACS_UINT_WIDTH = ULONG_WIDTH };
Paul Eggert's avatar
Paul Eggert committed
90
#  define EMACS_INT_MAX LONG_MAX
91
#  define pI "l"
92
# elif INTPTR_MAX <= LLONG_MAX
93 94
typedef long long int EMACS_INT;
typedef unsigned long long int EMACS_UINT;
95
enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH };
Paul Eggert's avatar
Paul Eggert committed
96
#  define EMACS_INT_MAX LLONG_MAX
97 98 99 100 101 102 103
/* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero,
   which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or
   later and the runtime version is 5.0.0 or later.  Otherwise,
   printf-like functions are declared with __ms_printf__ attribute,
   which will cause a warning for %lld etc.  */
#  if defined __MINGW32__						\
  && (!defined __USE_MINGW_ANSI_STDIO					\
104 105
      || (!defined MINGW_W64						\
	  && !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)))
106
#   define pI "I64"
107
#  else	 /* ! MinGW */
108 109
#   define pI "ll"
#  endif
110
# else
111
#  error "INTPTR_MAX too large"
112
# endif
113
#endif
Paul Eggert's avatar
Paul Eggert committed
114

115 116 117 118 119 120 121
/* Number of bits to put in each character in the internal representation
   of bool vectors.  This should not vary across implementations.  */
enum {  BOOL_VECTOR_BITS_PER_CHAR =
#define BOOL_VECTOR_BITS_PER_CHAR 8
        BOOL_VECTOR_BITS_PER_CHAR
};

122
/* An unsigned integer type representing a fixed-length bit sequence,
Paul Eggert's avatar
Paul Eggert committed
123
   suitable for bool vector words, GC mark bits, etc.  Normally it is size_t
124 125
   for speed, but on weird platforms it is unsigned char and not all
   its bits are used.  */
126
#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
127
typedef size_t bits_word;
128
# define BITS_WORD_MAX SIZE_MAX
129
enum { BITS_PER_BITS_WORD = SIZE_WIDTH };
130 131
#else
typedef unsigned char bits_word;
132
# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
133 134
enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
#endif
135
verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
136

137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
/* printmax_t and uprintmax_t are types for printing large integers.
   These are the widest integers that are supported for printing.
   pMd etc. are conversions for printing them.
   On C99 hosts, there's no problem, as even the widest integers work.
   Fall back on EMACS_INT on pre-C99 hosts.  */
#ifdef PRIdMAX
typedef intmax_t printmax_t;
typedef uintmax_t uprintmax_t;
# define pMd PRIdMAX
# define pMu PRIuMAX
#else
typedef EMACS_INT printmax_t;
typedef EMACS_UINT uprintmax_t;
# define pMd pI"d"
# define pMu pI"u"
#endif

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
/* Use pD to format ptrdiff_t values, which suffice for indexes into
   buffers and strings.  Emacs never allocates objects larger than
   PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
   In C99, pD can always be "t"; configure it here for the sake of
   pre-C99 libraries such as glibc 2.0 and Solaris 8.  */
#if PTRDIFF_MAX == INT_MAX
# define pD ""
#elif PTRDIFF_MAX == LONG_MAX
# define pD "l"
#elif PTRDIFF_MAX == LLONG_MAX
# define pD "ll"
#else
# define pD "t"
#endif

169
/* Extra internal type checking?  */
170

Paul Eggert's avatar
Paul Eggert committed
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
/* Define Emacs versions of <assert.h>'s 'assert (COND)' and <verify.h>'s
   'assume (COND)'.  COND should be free of side effects, as it may or
   may not be evaluated.

   'eassert (COND)' checks COND at runtime if ENABLE_CHECKING is
   defined and suppress_checking is false, and does nothing otherwise.
   Emacs dies if COND is checked and is false.  The suppress_checking
   variable is initialized to 0 in alloc.c.  Set it to 1 using a
   debugger to temporarily disable aborting on detected internal
   inconsistencies or error conditions.

   In some cases, a good compiler may be able to optimize away the
   eassert macro even if ENABLE_CHECKING is true, e.g., if XSTRING (x)
   uses eassert to test STRINGP (x), but a particular use of XSTRING
   is invoked only after testing that STRINGP (x) is true, making the
   test redundant.

   eassume is like eassert except that it also causes the compiler to
   assume that COND is true afterwards, regardless of whether runtime
   checking is enabled.  This can improve performance in some cases,
   though it can degrade performance in others.  It's often suboptimal
   for COND to call external functions or access volatile storage.  */

194
#ifndef ENABLE_CHECKING
195
# define eassert(cond) ((void) (false && (cond))) /* Check COND compiles.  */
Paul Eggert's avatar
Paul Eggert committed
196
# define eassume(cond) assume (cond)
197
#else /* ENABLE_CHECKING */
198

199
extern _Noreturn void die (const char *, const char *, int);
200

201
extern bool suppress_checking EXTERNALLY_VISIBLE;
202

203
# define eassert(cond)						\
204
   (suppress_checking || (cond) 				\
205
    ? (void) 0							\
206
    : die (# cond, __FILE__, __LINE__))
Paul Eggert's avatar
Paul Eggert committed
207 208 209 210 211 212
# define eassume(cond)						\
   (suppress_checking						\
    ? assume (cond)						\
    : (cond)							\
    ? (void) 0							\
    : die (# cond, __FILE__, __LINE__))
213
#endif /* ENABLE_CHECKING */
214

215

216 217 218
/* Use the configure flag --enable-check-lisp-object-type to make
   Lisp_Object use a struct type instead of the default int.  The flag
   causes CHECK_LISP_OBJECT_TYPE to be defined.  */
Eli Zaretskii's avatar
Eli Zaretskii committed
219

220
/***** Select the tagging scheme.  *****/
221
/* The following option controls the tagging scheme:
222 223 224 225
   - USE_LSB_TAG means that we can assume the least 3 bits of pointers are
     always 0, and we can thus use them to hold tag bits, without
     restricting our addressing space.

226 227
   If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
   restricting our possible address range.
228 229 230

   USE_LSB_TAG not only requires the least 3 bits of pointers returned by
   malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
Paul Eggert's avatar
Paul Eggert committed
231
   on some non-GC Lisp_Objects, all of which are aligned via
232
   GCALIGNED_UNION_MEMBER.  */
233

Paul Eggert's avatar
Paul Eggert committed
234 235 236
enum Lisp_Bits
  {
    /* Number of bits in a Lisp_Object value, not counting the tag.  */
237
    VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
238

Paul Eggert's avatar
Paul Eggert committed
239 240 241
    /* Number of bits in a Lisp fixnum value, not counting the tag.  */
    FIXNUM_BITS = VALBITS + 1
  };
Paul Eggert's avatar
Paul Eggert committed
242

243 244 245 246 247
/* Number of bits in a Lisp fixnum tag; can be used in #if.  */
DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS)
#define INTTYPEBITS (GCTYPEBITS - 1)
DEFINE_GDB_SYMBOL_END (INTTYPEBITS)

Paul Eggert's avatar
Paul Eggert committed
248 249
/* The maximum value that can be stored in a EMACS_INT, assuming all
   bits other than the type bits contribute to a nonnegative signed value.
250
   This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an
251
   expression involving VAL_MAX.  */
Paul Eggert's avatar
Paul Eggert committed
252
#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
253

Paul Eggert's avatar
Paul Eggert committed
254
/* Whether the least-significant bits of an EMACS_INT contain the tag.
255
   On hosts where pointers-as-ints do not exceed VAL_MAX / 2, USE_LSB_TAG is:
256 257
    a. unnecessary, because the top bits of an EMACS_INT are unused, and
    b. slower, because it typically requires extra masking.
Paul Eggert's avatar
Paul Eggert committed
258 259
   So, USE_LSB_TAG is true only on hosts where it might be useful.  */
DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
260
#define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
Paul Eggert's avatar
Paul Eggert committed
261 262
DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)

263 264 265 266 267
/* Mask for the value (as opposed to the type bits) of a Lisp object.  */
DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
DEFINE_GDB_SYMBOL_END (VALMASK)

Paul Eggert's avatar
Paul Eggert committed
268 269 270 271
#if !USE_LSB_TAG && !defined WIDE_EMACS_INT
# error "USE_LSB_TAG not supported on this platform; please report this." \
	"Try 'configure --with-wide-int' to work around the problem."
error !;
272
#endif
273

274 275
/* Minimum alignment requirement for Lisp objects, imposed by the
   internal representation of tagged pointers.  It is 2**GCTYPEBITS if
276 277
   USE_LSB_TAG, 1 otherwise.  It must be a literal integer constant,
   for older versions of GCC (through at least 4.9).  */
278
#if USE_LSB_TAG
279 280 281 282
# define GCALIGNMENT 8
# if GCALIGNMENT != 1 << GCTYPEBITS
#  error "GCALIGNMENT and GCTYPEBITS are inconsistent"
# endif
283
#else
284
# define GCALIGNMENT 1
285 286
#endif

287 288
/* To cause a union to have alignment of at least GCALIGNMENT, put
   GCALIGNED_UNION_MEMBER in its member list.
Paul Eggert's avatar
Paul Eggert committed
289

290 291 292 293 294
   If a struct is always GC-aligned (either by the GC, or via
   allocation in a containing union that has GCALIGNED_UNION_MEMBER)
   and does not contain a GC-aligned struct or union, putting
   GCALIGNED_STRUCT after its closing '}' can help the compiler
   generate better code.
Paul Eggert's avatar
Paul Eggert committed
295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312

   Although these macros are reasonably portable, they are not
   guaranteed on non-GCC platforms, as C11 does not require support
   for alignment to GCALIGNMENT and older compilers may ignore
   alignment requests.  For any type T where garbage collection
   requires alignment, use verify (GCALIGNED (T)) to verify the
   requirement on the current platform.  Types need this check if
   their objects can be allocated outside the garbage collector.  For
   example, struct Lisp_Symbol needs the check because of lispsym and
   struct Lisp_Cons needs it because of STACK_CONS.  */

#define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned;
#if HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED_STRUCT
#endif
#define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0)
313

314 315 316 317 318 319 320 321 322 323 324 325
/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
   integer.  Usually it is a pointer to a deliberately-incomplete type
   'union Lisp_X'.  However, it is EMACS_INT when Lisp_Objects and
   pointers differ in width.  */

#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
#if LISP_WORDS_ARE_POINTERS
typedef union Lisp_X *Lisp_Word;
#else
typedef EMACS_INT Lisp_Word;
#endif

326 327 328 329 330 331 332
/* 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.
   There's no need to inline everything, just the operations that
   would otherwise cause a serious performance problem.

   For each such operation OP, define a macro lisp_h_OP that contains
Paul Eggert's avatar
Paul Eggert committed
333
   the operation's implementation.  That way, OP can be implemented
334 335 336 337 338 339 340 341 342 343 344 345 346 347
   via a macro definition like this:

     #define OP(x) lisp_h_OP (x)

   and/or via a function definition like this:

     Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); }

   without worrying about the implementations diverging, since
   lisp_h_OP defines the actual implementation.  The lisp_h_OP macros
   are intended to be private to this include file, and should not be
   used elsewhere.

   FIXME: Remove the lisp_h_OP macros, and define just the inline OP
348 349
   functions, once "gcc -Og" (new to GCC 4.8) works well enough for
   Emacs developers.  Maybe in the year 2020.  See Bug#11935.
350

351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
   For the macros that have corresponding functions (defined later),
   see these functions for commentary.  */

/* Convert among the various Lisp-related types: I for EMACS_INT, L
   for Lisp_Object, P for void *.  */
#if !CHECK_LISP_OBJECT_TYPE
# if LISP_WORDS_ARE_POINTERS
#  define lisp_h_XLI(o) ((EMACS_INT) (o))
#  define lisp_h_XIL(i) ((Lisp_Object) (i))
#  define lisp_h_XLP(o) ((void *) (o))
#  define lisp_h_XPL(p) ((Lisp_Object) (p))
# else
#  define lisp_h_XLI(o) (o)
#  define lisp_h_XIL(i) (i)
#  define lisp_h_XLP(o) ((void *) (uintptr_t) (o))
#  define lisp_h_XPL(p) ((Lisp_Object) (uintptr_t) (p))
# endif
368
#else
369 370 371 372 373 374 375 376 377 378 379
# if LISP_WORDS_ARE_POINTERS
#  define lisp_h_XLI(o) ((EMACS_INT) (o).i)
#  define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)})
#  define lisp_h_XLP(o) ((void *) (o).i)
#  define lisp_h_XPL(p) lisp_h_XIL (p)
# else
#  define lisp_h_XLI(o) ((o).i)
#  define lisp_h_XIL(i) ((Lisp_Object) {i})
#  define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i)
#  define lisp_h_XPL(p) ((Lisp_Object) {(uintptr_t) (p)})
# endif
380
#endif
381

382
#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
383
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
384
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
385
   ((ok) ? (void) 0 : wrong_type_argument (predicate, x))
386
#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
387
#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
388 389 390 391 392
#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)
393 394
#define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_SET_SYMBOL_VAL(sym, v) \
395 396 397 398 399
   (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
    (sym)->u.s.val.value = (v))
#define lisp_h_SYMBOL_CONSTANT_P(sym) \
   (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
400
#define lisp_h_SYMBOL_VAL(sym) \
401
   (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
402 403 404 405 406 407
#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_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
408 409
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
410
#define lisp_h_XCONS(a) \
411
   (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
Tom Tromey's avatar
Tom Tromey committed
412
#define lisp_h_XHASH(a) XUFIXNUM (a)
413 414 415 416
#ifndef GC_CHECK_CONS_LIST
# define lisp_h_check_cons_list() ((void) 0)
#endif
#if USE_LSB_TAG
417
# define lisp_h_make_fixnum(n) \
418
    XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
Tom Tromey's avatar
Tom Tromey committed
419 420
# define lisp_h_XFIXNAT(a) XFIXNUM (a)
# define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS)
421 422 423
# ifdef __CHKP__
#  define lisp_h_XSYMBOL(a) \
    (eassert (SYMBOLP (a)), \
424 425
     (struct Lisp_Symbol *) ((char *) XUNTAG (a, Lisp_Symbol, \
					      struct Lisp_Symbol) \
426 427 428 429
			     + (intptr_t) lispsym))
# else
   /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7.  */
#  define lisp_h_XSYMBOL(a) \
430
    (eassert (SYMBOLP (a)), \
431
     (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
432
			     + (char *) lispsym))
433
# endif
434 435 436 437 438
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
#endif

/* When compiling via gcc -O0, define the key operations as macros, as
   Emacs is too slow otherwise.  To disable this optimization, compile
439
   with -DINLINING=false.  */
440 441 442
#if (defined __NO_INLINE__ \
     && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
     && ! (defined INLINING && ! INLINING))
443 444 445 446 447 448
# define DEFINE_KEY_OPS_AS_MACROS true
#else
# define DEFINE_KEY_OPS_AS_MACROS false
#endif

#if DEFINE_KEY_OPS_AS_MACROS
449 450
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
451 452
# define XLP(o) lisp_h_XLP (o)
# define XPL(p) lisp_h_XPL (p)
453
# define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x)
454
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
455
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
456 457 458
# define CONSP(x) lisp_h_CONSP (x)
# define EQ(x, y) lisp_h_EQ (x, y)
# define FLOATP(x) lisp_h_FLOATP (x)
459
# define FIXNUMP(x) lisp_h_FIXNUMP (x)
460 461 462
# define NILP(x) lisp_h_NILP (x)
# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
Noam Postavsky's avatar
Noam Postavsky committed
463
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
464 465
# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
# define SYMBOLP(x) lisp_h_SYMBOLP (x)
466
# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
467 468 469 470 471 472 473 474 475
# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
# define XCAR(c) lisp_h_XCAR (c)
# define XCDR(c) lisp_h_XCDR (c)
# define XCONS(a) lisp_h_XCONS (a)
# define XHASH(a) lisp_h_XHASH (a)
# ifndef GC_CHECK_CONS_LIST
#  define check_cons_list() lisp_h_check_cons_list ()
# endif
# if USE_LSB_TAG
476
#  define make_fixnum(n) lisp_h_make_fixnum (n)
Tom Tromey's avatar
Tom Tromey committed
477 478
#  define XFIXNAT(a) lisp_h_XFIXNAT (a)
#  define XFIXNUM(a) lisp_h_XFIXNUM (a)
479
#  define XSYMBOL(a) lisp_h_XSYMBOL (a)
480 481 482 483 484
#  define XTYPE(a) lisp_h_XTYPE (a)
# endif
#endif


485
/* Define the fundamental Lisp data structures.  */
Jim Blandy's avatar
Jim Blandy committed
486

487 488 489
/* This is the set of Lisp data types.  If you want to define a new
   data type, read the comments after Lisp_Fwd_Type definition
   below.  */
Jim Blandy's avatar
Jim Blandy committed
490

491 492
/* Lisp integers use 2 tags, to give them one extra bit, thus
   extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1.  */
Paul Eggert's avatar
Paul Eggert committed
493
#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
494
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
495

Paul Eggert's avatar
Paul Eggert committed
496
/* Idea stolen from GDB.  Pedantic GCC complains about enum bitfields,
Paul Eggert's avatar
Paul Eggert committed
497 498
   and xlc and Oracle Studio c99 complain vociferously about them.  */
#if (defined __STRICT_ANSI__ || defined __IBMC__ \
Paul Eggert's avatar
Paul Eggert committed
499
     || (defined __SUNPRO_C && __STDC__))
500 501 502 503 504 505
#define ENUM_BF(TYPE) unsigned int
#else
#define ENUM_BF(TYPE) enum TYPE
#endif


Jim Blandy's avatar
Jim Blandy committed
506 507
enum Lisp_Type
  {
508
    /* Symbol.  XSYMBOL (object) points to a struct Lisp_Symbol.  */
Paul Eggert's avatar
Paul Eggert committed
509
    Lisp_Symbol = 0,
Jim Blandy's avatar
Jim Blandy committed
510

511
    /* Type 1 is currently unused.  */
Paul Eggert's avatar
Paul Eggert committed
512

513
    /* Fixnum.  XFIXNUM (obj) is the integer value.  */
Paul Eggert's avatar
Paul Eggert committed
514 515
    Lisp_Int0 = 2,
    Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
Jim Blandy's avatar
Jim Blandy committed
516 517

    /* String.  XSTRING (object) points to a struct Lisp_String.
518
       The length of the string, and its contents, are stored therein.  */
Paul Eggert's avatar
Paul Eggert committed
519
    Lisp_String = 4,
Jim Blandy's avatar
Jim Blandy committed
520

521
    /* Vector of Lisp objects, or something resembling it.
522
       XVECTOR (object) points to a struct Lisp_Vector, which contains
523 524
       the size and contents.  The size field also contains the type
       information, if it's not a real vector object.  */
525
    Lisp_Vectorlike = 5,
Jim Blandy's avatar
Jim Blandy committed
526

527
    /* Cons.  XCONS (object) points to a struct Lisp_Cons.  */
Paul Eggert's avatar
Paul Eggert committed
528
    Lisp_Cons = USE_LSB_TAG ? 3 : 6,
529

Daniel Colascione's avatar
Daniel Colascione committed
530
    /* Must be last entry in Lisp_Type enumeration.  */
Paul Eggert's avatar
Paul Eggert committed
531
    Lisp_Float = 7
Jim Blandy's avatar
Jim Blandy committed
532 533
  };

534 535 536 537 538 539 540 541 542
/* These are the types of forwarding objects used in the value slot
   of symbols for special built-in variables whose value is stored in
   C variables.  */
enum Lisp_Fwd_Type
  {
    Lisp_Fwd_Int,		/* Fwd to a C `int' variable.  */
    Lisp_Fwd_Bool,		/* Fwd to a C boolean var.  */
    Lisp_Fwd_Obj,		/* Fwd to a C Lisp_Object variable.  */
    Lisp_Fwd_Buffer_Obj,	/* Fwd to a Lisp_Object field of buffers.  */
Paul Eggert's avatar
Paul Eggert committed
543
    Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
544 545
  };

546
/* If you want to define a new Lisp data type, here are some
547
   instructions.
548 549 550

   First, there are already a couple of Lisp types that can be used if
   your new type does not need to be exposed to Lisp programs nor
551 552
   displayed to users.  These are Lisp_Misc_Ptr and PVEC_OTHER,
   which are both vectorlike objects.  The former
Paul Eggert's avatar
Paul Eggert committed
553 554 555
   is suitable for stashing a pointer in a Lisp object; the pointer
   might be to some low-level C object that contains auxiliary
   information.  The latter is useful for vector-like Lisp objects
556 557 558 559 560 561 562
   that need to be used as part of other objects, but which are never
   shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
   an example).

   These two types don't look pretty when printed, so they are
   unsuitable for Lisp objects that can be exposed to users.

563 564 565 566
   To define a new data type, add a pseudovector subtype by extending
   the pvec_type enumeration.  A pseudovector provides one or more
   slots for Lisp objects, followed by struct members that are
   accessible only from C.
567

Paul Eggert's avatar
Paul Eggert committed
568 569
   There is no way to explicitly free a Lisp Object; only the garbage
   collector frees them.
570 571 572 573 574

   For a new pseudovector, it's highly desirable to limit the size
   of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c).
   Otherwise you will need to change sweep_vectors (also in alloc.c).

575 576 577 578 579 580 581 582 583
   Then you will need to add switch branches in print.c (in
   print_object, to print your object, and possibly also in
   print_preprocess) and to alloc.c, to mark your object (in
   mark_object) and to free it (in gc_sweep).  The latter is also the
   right place to call any code specific to your data type that needs
   to run when the object is recycled -- e.g., free any additional
   resources allocated for it that are not Lisp objects.  You can even
   make a pointer to the function that frees the resources a slot in
   your object -- this way, the same object could be used to represent
584 585 586 587
   several disparate C structures.

   You also need to add the new type to the constant
   `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el.  */
588

Jim Blandy's avatar
Jim Blandy committed
589

590 591 592
/* 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;'.
Jim Blandy's avatar
Jim Blandy committed
593

594 595
   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.  */
Jim Blandy's avatar
Jim Blandy committed
596

597 598 599 600
#ifdef CHECK_LISP_OBJECT_TYPE
typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
# define LISP_INITIALLY(w) {w}
# undef CHECK_LISP_OBJECT_TYPE
601
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
602 603 604
#else
typedef Lisp_Word Lisp_Object;
# define LISP_INITIALLY(w) (w)
605
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
606
#endif
607 608

/* Forward declarations.  */
Jim Blandy's avatar
Jim Blandy committed
609

610 611 612 613
/* Defined in this file.  */
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
					      Lisp_Object);

Paul Eggert's avatar
Paul Eggert committed
614 615 616
/* Defined in bignum.c.  */
extern double bignum_to_double (Lisp_Object);
extern Lisp_Object make_bigint (intmax_t);
617
extern Lisp_Object make_biguint (uintmax_t);
Paul Eggert's avatar
Paul Eggert committed
618

619 620 621
/* Defined in chartab.c.  */
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern void char_table_set (Lisp_Object, int, Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
622

623
/* Defined in data.c.  */
624
extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object);
Noam Postavsky's avatar
Noam Postavsky committed
625

626 627

/* Defined in emacs.c.  */
Daniel Colascione's avatar
Daniel Colascione committed
628 629 630 631

/* Set after Emacs has started up the first time.
   Prevents reinitialization of the Lisp world and keymaps on
   subsequent starts.  */
632 633
extern bool initialized;

Daniel Colascione's avatar
Daniel Colascione committed
634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730
extern struct gflags {
  /* True means this Emacs instance was born to dump.  */
#if defined (HAVE_PDUMPER) || !defined (CANNOT_DUMP)
  bool will_dump_ : 1;
  bool will_bootstrap_ : 1;
#endif
#if defined (HAVE_PDUMPER)
  /* Set in an Emacs process that will likely dump with pdumper; all
     Emacs processes may dump with pdumper, however.  */
  bool will_dump_with_pdumper_ : 1;
  /* Set in an Emacs process that has been restored from a portable
     dump.  */
  bool dumped_with_pdumper_ : 1;
#endif
#ifndef CANNOT_DUMP
  bool will_dump_with_unexec_ : 1;
  /* Set in an Emacs process that has been restored from an unexec
     dump.  */
  bool dumped_with_unexec_ : 1;
  /* We promise not to unexec: useful for hybrid malloc.  */
  bool will_not_unexec_ : 1;
#endif
} gflags;

INLINE bool
will_dump_p (void)
{
#if HAVE_PDUMPER || !defined (CANNOT_DUMP)
  return gflags.will_dump_;
#else
  return false;
#endif
}

INLINE bool
will_bootstrap_p (void)
{
#if HAVE_PDUMPER || !defined (CANNOT_DUMP)
  return gflags.will_bootstrap_;
#else
  return false;
#endif
}

INLINE bool
will_dump_with_pdumper_p (void)
{
#if HAVE_PDUMPER
  return gflags.will_dump_with_pdumper_;
#else
  return false;
#endif
}

INLINE bool
dumped_with_pdumper_p (void)
{
#if HAVE_PDUMPER
  return gflags.dumped_with_pdumper_;
#else
  return false;
#endif
}

INLINE bool
will_dump_with_unexec_p (void)
{
#ifdef CANNOT_DUMP
  return false;
#else
  return gflags.will_dump_with_unexec_;
#endif
}

INLINE bool
dumped_with_unexec_p (void)
{
#ifdef CANNOT_DUMP
  return false;
#else
  return gflags.dumped_with_unexec_;
#endif
}

/* This function is the opposite of will_dump_with_unexec_p(), except
   that it returns false before main runs.  It's important to use
   gmalloc for any pre-main allocations if we're going to unexec.  */
INLINE bool
definitely_will_not_unexec_p (void)
{
#ifdef CANNOT_DUMP
  return true;
#else
  return gflags.will_not_unexec_;
#endif
}

731 732 733
/* Defined in floatfns.c.  */
extern double extract_float (Lisp_Object);

734 735 736

/* Low-level conversion and type checking.  */

737 738 739 740
/* Convert among various types use to implement Lisp_Object.  At the
   machine level, these operations may widen or narrow their arguments
   if pointers differ in width from EMACS_INT; otherwise they are
   no-ops.  */
741 742 743 744 745 746 747 748 749 750 751 752 753

INLINE EMACS_INT
(XLI) (Lisp_Object o)
{
  return lisp_h_XLI (o);
}

INLINE Lisp_Object
(XIL) (EMACS_INT i)
{
  return lisp_h_XIL (i);
}

754 755 756 757 758 759 760 761 762 763 764 765
INLINE void *
(XLP) (Lisp_Object o)
{
  return lisp_h_XLP (o);
}

INLINE Lisp_Object
(XPL) (void *p)
{
  return lisp_h_XPL (p);
}

766 767 768 769 770 771 772 773 774 775 776 777 778
/* Extract A's type.  */

INLINE enum Lisp_Type
(XTYPE) (Lisp_Object a)
{
#if USE_LSB_TAG
  return lisp_h_XTYPE (a);
#else
  EMACS_UINT i = XLI (a);
  return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
#endif
}

779 780 781 782 783 784 785 786 787
/* True if A has type tag TAG.
   Equivalent to XTYPE (a) == TAG, but often faster.  */

INLINE bool
(TAGGEDP) (Lisp_Object a, enum Lisp_Type tag)
{
  return lisp_h_TAGGEDP (a, tag);
}

788 789 790 791 792 793
INLINE void
(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x)
{
  lisp_h_CHECK_TYPE (ok, predicate, x);
}

794 795
/* Extract A's pointer value, assuming A's Lisp type is TYPE and the
   extracted pointer's type is CTYPE *.  */
796

797 798
#define XUNTAG(a, type, ctype) ((ctype *) \
				((char *) XLP (a) - LISP_WORD_TAG (type)))
799 800

/* Interned state of a symbol.  */
801

802 803 804 805 806 807
enum symbol_interned
{
  SYMBOL_UNINTERNED = 0,
  SYMBOL_INTERNED = 1,
  SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
};
808

809 810 811 812 813 814 815 816
enum symbol_redirect
{
  SYMBOL_PLAINVAL  = 4,
  SYMBOL_VARALIAS  = 1,
  SYMBOL_LOCALIZED = 2,
  SYMBOL_FORWARDED = 3
};

Noam Postavsky's avatar
Noam Postavsky committed
817 818 819 820 821 822 823
enum symbol_trapped_write
{
  SYMBOL_UNTRAPPED_WRITE = 0,
  SYMBOL_NOWRITE = 1,
  SYMBOL_TRAPPED_WRITE = 2
};

824 825
struct Lisp_Symbol
{
826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868
  union
  {
    struct
    {
      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'.  */
      ENUM_BF (symbol_redirect) redirect : 3;

      /* 0 : normal case, just set the value
	 1 : constant, cannot set, e.g. nil, t, :keywords.
	 2 : trap the write, call watcher functions.  */
      ENUM_BF (symbol_trapped_write) trapped_write : 2;

      /* Interned state of the symbol.  This is an enumerator from
	 enum symbol_interned.  */
      unsigned interned : 2;

      /* True means that this variable has been explicitly declared
	 special (with `defvar' etc), and shouldn't be lexically bound.  */
      bool_bf declared_special : 1;

      /* True if pointed to from purespace and hence can't be GC'd.  */
      bool_bf pinned : 1;

      /* The symbol's name, as a Lisp string.  */
      Lisp_Object name;

      /* Value of the symbol or Qunbound if unbound.  Which alternative of the
	 union is used depends on the `redirect' field above.  */
      union {
	Lisp_Object value;
	struct Lisp_Symbol *alias;
	struct Lisp_Buffer_Local_Value *blv;
	union Lisp_Fwd *fwd;
      } val;

      /* Function value of the symbol or Qnil if not fboundp.  */
      Lisp_Object function;
869

870 871
      /* The symbol's property list.  */
      Lisp_Object plist;
872

873 874 875
      /* Next symbol in obarray bucket, if the symbol is interned.  */
      struct Lisp_Symbol *next;
    } s;
Paul Eggert's avatar
Paul Eggert committed
876
    GCALIGNED_UNION_MEMBER
877
  } u;
878
};
Paul Eggert's avatar
Paul Eggert committed
879
verify (GCALIGNED (struct Lisp_Symbol));
880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905

/* Declare a Lisp-callable function.  The MAXARGS parameter has the same
   meaning as in the DEFUN macro, and is used to construct a prototype.  */
/* We can use the same trick as in the DEFUN macro to generate the
   appropriate prototype.  */
#define EXFUN(fnname, maxargs) \
  extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs

/* Note that the weird token-substitution semantics of ANSI C makes
   this work for MANY and UNEVALLED.  */
#define DEFUN_ARGS_MANY		(ptrdiff_t, Lisp_Object *)
#define DEFUN_ARGS_UNEVALLED	(Lisp_Object)
#define DEFUN_ARGS_0	(void)
#define DEFUN_ARGS_1	(Lisp_Object)
#define DEFUN_ARGS_2	(Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_3	(Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_4	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_5	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object)
#define DEFUN_ARGS_6	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_7	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_8	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)

906 907 908
/* untagged_ptr represents a pointer before tagging, and Lisp_Word_tag
   contains a possibly-shifted tag to be added to an untagged_ptr to
   convert it to a Lisp_Word.  */
909 910 911 912 913 914 915 916 917 918 919 920 921
#if LISP_WORDS_ARE_POINTERS
/* untagged_ptr is a pointer so that the compiler knows that TAG_PTR
   yields a pointer; this can help with gcc -fcheck-pointer-bounds.
   It is char * so that adding a tag uses simple machine addition.  */
typedef char *untagged_ptr;
typedef uintptr_t Lisp_Word_tag;
#else
/* untagged_ptr is an unsigned integer instead of a pointer, so that
   it can be added to the possibly-wider Lisp_Word_tag type without
   losing information.  */
typedef uintptr_t untagged_ptr;
typedef EMACS_UINT Lisp_Word_tag;
#endif
922

923 924 925 926
/* A integer value tagged with TAG, and otherwise all zero.  */
#define LISP_WORD_TAG(tag) \
  ((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS))

927
/* An initializer for a Lisp_Object that contains TAG along with PTR.  */
928
#define TAG_PTR(tag, ptr) \
929
  LISP_INITIALLY ((Lisp_Word) ((untagged_ptr) (ptr) + LISP_WORD_TAG (tag)))
930

931 932
/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
   designed for use as an initializer, even for a constant initializer.  */
933 934
#define LISPSYM_INITIALLY(name) \
  TAG_PTR (Lisp_Symbol, (char *) (intptr_t) ((i##name) * sizeof *lispsym))
935

936 937
/* Declare extern constants for Lisp symbols.  These can be helpful
   when using a debugger like GDB, on older platforms where the debug
938 939 940 941 942 943 944 945 946
   format does not represent C macros.  However, they are unbounded
   and would just be asking for trouble if checking pointer bounds.  */
#ifdef __CHKP__
# define DEFINE_LISP_SYMBOL(name)
#else
# define DEFINE_LISP_SYMBOL(name) \
   DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
   DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
#endif
947

948 949 950 951
/* The index of the C-defined Lisp symbol SYM.
   This can be used in a static initializer.  */
#define SYMBOL_INDEX(sym) i##sym

952 953
/* By default, define macros for Qt, etc., as this leads to a bit
   better performance in the core Emacs interpreter.  A plugin can
Paul Eggert's avatar
Paul Eggert committed
954
   define DEFINE_NON_NIL_Q_SYMBOL_MACROS to be false, to be portable to
955
   other Emacs instances that assign different values to Qt, etc.  */
Paul Eggert's avatar
Paul Eggert committed
956 957
#ifndef DEFINE_NON_NIL_Q_SYMBOL_MACROS
# define DEFINE_NON_NIL_Q_SYMBOL_MACROS true
958 959
#endif

Daniel Colascione's avatar
Daniel Colascione committed
960 961 962 963 964 965 966 967 968 969 970 971 972
/* True if N is a power of 2.  N should be positive.  */

#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0)

/* Return X rounded to the next multiple of Y.  Y should be positive,
   and Y - 1 + X should not overflow.  Arguments should not have side
   effects, as they are evaluated more than once.  Tune for Y being a
   power of 2.  */

#define ROUNDUP(x, y) (POWER_OF_2 (y)					\
                       ? ((y) - 1 + (x)) & ~ ((y) - 1)			\
                       : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y))

973
#include "globals.h"
974

Tom Tromey's avatar
Tom Tromey committed
975 976 977
/* 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
978
   and PSEUDOVECTORP cast their pointers to union vectorlike_header *,
Tom Tromey's avatar
Tom Tromey committed
979 980
   because when two such pointers potentially alias, a compiler won't
   incorrectly reorder loads and stores to their size fields.  See
Paul Eggert's avatar
Paul Eggert committed
981 982 983
   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.  */
984
union vectorlike_header
Tom Tromey's avatar
Tom Tromey committed
985
  {
986
    /* The main member contains various pieces of information:
Tom Tromey's avatar
Tom Tromey committed
987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007
       - 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;
  };

1008 1009 1010 1011 1012
INLINE bool
(SYMBOLP) (Lisp_Object x)
{
  return lisp_h_SYMBOLP (x);
}
Tom Tromey's avatar
Tom Tromey committed
1013

1014
INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
1015 1016 1017 1018 1019 1020
(XSYMBOL) (Lisp_Object a)
{
#if USE_LSB_TAG
  return lisp_h_XSYMBOL (a);
#else
  eassert (SYMBOLP (a));
1021
  intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
1022
  void *p = (char *) lispsym + i;
1023 1024 1025 1026 1027
# ifdef __CHKP__
  /* Bypass pointer checking.  Although this could be improved it is
     probably not worth the trouble.  */
  p = __builtin___bnd_set_ptr_bounds (p, sizeof (struct Lisp_Symbol));
# endif
1028 1029 1030
  return p;
#endif
}
1031

1032 1033
INLINE Lisp_Object
make_lisp_symbol (struct Lisp_Symbol *sym)
1034
{
1035
#ifdef __CHKP__
1036 1037 1038 1039 1040
  /* Although '__builtin___bnd_narrow_ptr_bounds (sym, sym, sizeof *sym)'
     should be more efficient, it runs afoul of GCC bug 83251
     <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>.
     Also, attempting to call __builtin___bnd_chk_ptr_bounds (sym, sizeof *sym)
     here seems to trigger a GCC bug, as yet undiagnosed.  */
1041 1042
  char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym);
  char *symoffset = addr - (intptr_t) lispsym;
1043
#else
1044 1045
  /* If !__CHKP__, GCC 7 x86-64 generates faster code if lispsym is
     cast to char * rather than to intptr_t.  */
1046 1047 1048
  char *symoffset = (char *) ((char *) sym - (char *) lispsym);
#endif
  Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
1049 1050
  eassert (XSYMBOL (a) == sym);
  return a;
1051 1052 1053
}

INLINE Lisp_Object
1054
builtin_lisp_symbol (int index)
1055
{
1056
  return make_lisp_symbol (&lispsym[index]);
1057 1058 1059 1060 1061
}

INLINE void
(CHECK_SYMBOL) (Lisp_Object x)
{
Andreas Schwab's avatar
Andreas Schwab committed
1062
  lisp_h_CHECK_SYMBOL (x);
1063
}
1064

1065
/* In the size word of a vector, this bit means the vector has been marked.  */
1066

1067
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
1068
# define ARRAY_MARK_FLAG PTRDIFF_MIN
1069
DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
1070

1071 1072
/* In the size word of a struct Lisp_Vector, this bit means it's really
   some other vector-like object.  */
1073
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
1074
# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
1075
DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
1076

1077
/* In a pseudovector, the size field actually contains a word with one
1078 1079
   PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
   with PVEC_TYPE_MASK to indicate the actual type.  */
1080 1081
enum pvec_type
{
1082
  PVEC_NORMAL_VECTOR,
1083
  PVEC_FREE,
1084 1085 1086 1087 1088 1089 1090 1091
  PVEC_BIGNUM,
  PVEC_MARKER,
  PVEC_OVERLAY,
  PVEC_FINALIZER,
  PVEC_MISC_PTR,
#ifdef HAVE_MODULES
  PVEC_USER_PTR,
#endif
1092 1093 1094 1095 1096 1097 1098 1099 1100
  PVEC_PROCESS,
  PVEC_FRAME,
  PVEC_WINDOW,
  PVEC_BOOL_VECTOR,
  PVEC_BUFFER,
  PVEC_HASH_TABLE,
  PVEC_TERMINAL,
  PVEC_WINDOW_CONFIGURATION,
  PVEC_SUBR,
1101
  PVEC_OTHER,            /* Should never be visible to Elisp code.  */
1102 1103
  PVEC_XWIDGET,
  PVEC_XWIDGET_VIEW,
1104
  PVEC_THREAD,
1105
  PVEC_MUTEX,
Tom Tromey's avatar
Tom Tromey committed
1106
  PVEC_CONDVAR,
1107
  PVEC_MODULE_FUNCTION,
1108

1109 1110 1111 1112
  /* These should be last, check internal_equal to see why.  */
  PVEC_COMPILED,
  PVEC_CHAR_TABLE,
  PVEC_SUB_CHAR_TABLE,
1113
  PVEC_RECORD,
1114
  PVEC_FONT /* Should be last because it's used for range checking.  */
1115
};
1116

Paul Eggert's avatar
Paul Eggert committed
1117
enum More_Lisp_Bits
1118
  {
Paul Eggert's avatar
Paul Eggert committed
1119 1120 1121 1122 1123
    /* 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.  */
1124
    PSEUDOVECTOR_SIZE_BITS = 12,
1125
    PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
1126 1127 1128 1129

    /* 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,
1130
    PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
1131 1132 1133 1134
			      << PSEUDOVECTOR_SIZE_BITS),

    /* Used to extract pseudovector subtype information.  */
    PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
Paul Eggert's avatar
Paul Eggert committed
1135
    PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
Paul Eggert's avatar
Paul Eggert committed
1136
  };
Jim Blandy's avatar
Jim Blandy committed
1137

1138
/* These functions extract various sorts of values from a Lisp_Object.
1139 1140 1141
   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.  */