lisp.h 151 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"
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 ""
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
231
   on the few static Lisp_Objects used, all of which are aligned via
232
   'char alignas (GCALIGNMENT) gcaligned;' inside a union.  */
233

Paul Eggert's avatar
Paul Eggert committed
234 235
enum Lisp_Bits
  {
236 237 238
    /* 2**GCTYPEBITS.  This must be a macro that expands to a literal
       integer constant, for older versions of GCC (through at least 4.9).  */
#define GCALIGNMENT 8
239

Paul Eggert's avatar
Paul Eggert committed
240
    /* Number of bits in a Lisp_Object value, not counting the tag.  */
241
    VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
242

Paul Eggert's avatar
Paul Eggert committed
243 244 245 246 247 248
    /* Number of bits in a Lisp fixnum tag.  */
    INTTYPEBITS = GCTYPEBITS - 1,

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

250 251 252 253
#if GCALIGNMENT != 1 << GCTYPEBITS
# error "GCALIGNMENT and GCTYPEBITS are inconsistent"
#endif

Paul Eggert's avatar
Paul Eggert committed
254 255
/* 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.
256
   This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an
257
   expression involving VAL_MAX.  */
Paul Eggert's avatar
Paul Eggert committed
258
#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
259

Paul Eggert's avatar
Paul Eggert committed
260
/* Whether the least-significant bits of an EMACS_INT contain the tag.
261
   On hosts where pointers-as-ints do not exceed VAL_MAX / 2, USE_LSB_TAG is:
262 263
    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
264 265
   So, USE_LSB_TAG is true only on hosts where it might be useful.  */
DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
266
#define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
Paul Eggert's avatar
Paul Eggert committed
267 268
DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)

269 270 271 272 273
/* 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
274 275 276 277
#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 !;
278
#endif
279

280 281 282 283 284 285 286
/* 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
287
   the operation's implementation.  That way, OP can be implemented
288 289 290 291 292 293 294 295 296 297 298 299 300 301
   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
302 303
   functions, once "gcc -Og" (new to GCC 4.8) works well enough for
   Emacs developers.  Maybe in the year 2020.  See Bug#11935.
304 305

   Commentary for these macros can be found near their corresponding
306
   functions, below.  */
307 308 309 310 311 312 313 314 315 316

#if CHECK_LISP_OBJECT_TYPE
# define lisp_h_XLI(o) ((o).i)
# define lisp_h_XIL(i) ((Lisp_Object) { i })
#else
# define lisp_h_XLI(o) (o)
# define lisp_h_XIL(i) (i)
#endif
#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
317
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
318
   ((ok) ? (void) 0 : wrong_type_argument (predicate, x))
319 320 321
#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons)
#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float)
322
#define lisp_h_INTEGERP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0)
323 324 325 326
#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
#define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_SET_SYMBOL_VAL(sym, v) \
327 328 329 330 331
   (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)
332
#define lisp_h_SYMBOL_VAL(sym) \
333
   (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
334 335
#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
336 337
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
338 339 340 341 342 343 344
#define lisp_h_XCONS(a) \
   (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
#define lisp_h_XHASH(a) XUINT (a)
#ifndef GC_CHECK_CONS_LIST
# define lisp_h_check_cons_list() ((void) 0)
#endif
#if USE_LSB_TAG
345
# define lisp_h_make_number(n) \
346
    XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
347 348
# define lisp_h_XFASTINT(a) XINT (a)
# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
349 350
# define lisp_h_XSYMBOL(a) \
    (eassert (SYMBOLP (a)), \
351
     (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
352
			     + (char *) lispsym))
353
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
354 355 356
# define lisp_h_XUNTAG(a, type) \
    __builtin_assume_aligned ((void *) (intptr_t) (XLI (a) - (type)), \
			      GCALIGNMENT)
357 358 359 360
#endif

/* When compiling via gcc -O0, define the key operations as macros, as
   Emacs is too slow otherwise.  To disable this optimization, compile
361
   with -DINLINING=false.  */
362 363 364
#if (defined __NO_INLINE__ \
     && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
     && ! (defined INLINING && ! INLINING))
365 366 367 368 369 370
# define DEFINE_KEY_OPS_AS_MACROS true
#else
# define DEFINE_KEY_OPS_AS_MACROS false
#endif

#if DEFINE_KEY_OPS_AS_MACROS
371 372 373 374
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
375
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
376 377 378 379 380 381 382 383 384
# define CONSP(x) lisp_h_CONSP (x)
# define EQ(x, y) lisp_h_EQ (x, y)
# define FLOATP(x) lisp_h_FLOATP (x)
# define INTEGERP(x) lisp_h_INTEGERP (x)
# define MARKERP(x) lisp_h_MARKERP (x)
# define MISCP(x) lisp_h_MISCP (x)
# 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
385
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
386 387 388 389 390 391 392 393 394 395 396 397 398 399
# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
# define SYMBOLP(x) lisp_h_SYMBOLP (x)
# 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
#  define make_number(n) lisp_h_make_number (n)
#  define XFASTINT(a) lisp_h_XFASTINT (a)
#  define XINT(a) lisp_h_XINT (a)
400
#  define XSYMBOL(a) lisp_h_XSYMBOL (a)
401 402 403 404 405 406
#  define XTYPE(a) lisp_h_XTYPE (a)
#  define XUNTAG(a, type) lisp_h_XUNTAG (a, type)
# endif
#endif


407
/* Define the fundamental Lisp data structures.  */
Jim Blandy's avatar
Jim Blandy committed
408

409 410 411
/* 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
412

413 414
/* 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
415
#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
416
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
417

Paul Eggert's avatar
Paul Eggert committed
418
/* Idea stolen from GDB.  Pedantic GCC complains about enum bitfields,
419 420 421 422
   MSVC doesn't support them, and xlc and Oracle Studio c99 complain
   vociferously about them.  */
#if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \
     || (defined __SUNPRO_C && __STDC__))
423 424 425 426 427 428
#define ENUM_BF(TYPE) unsigned int
#else
#define ENUM_BF(TYPE) enum TYPE
#endif


Jim Blandy's avatar
Jim Blandy committed
429 430
enum Lisp_Type
  {
431
    /* Symbol.  XSYMBOL (object) points to a struct Lisp_Symbol.  */
Paul Eggert's avatar
Paul Eggert committed
432
    Lisp_Symbol = 0,
Jim Blandy's avatar
Jim Blandy committed
433

434 435
    /* Miscellaneous.  XMISC (object) points to a union Lisp_Misc,
       whose first member indicates the subtype.  */
Paul Eggert's avatar
Paul Eggert committed
436 437 438 439 440
    Lisp_Misc = 1,

    /* Integer.  XINT (obj) is the integer value.  */
    Lisp_Int0 = 2,
    Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
Jim Blandy's avatar
Jim Blandy committed
441 442

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

446
    /* Vector of Lisp objects, or something resembling it.
447
       XVECTOR (object) points to a struct Lisp_Vector, which contains
448 449
       the size and contents.  The size field also contains the type
       information, if it's not a real vector object.  */
450
    Lisp_Vectorlike = 5,
Jim Blandy's avatar
Jim Blandy committed
451

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

Paul Eggert's avatar
Paul Eggert committed
455
    Lisp_Float = 7
Jim Blandy's avatar
Jim Blandy committed
456 457
  };

458
/* This is the set of data types that share a common structure.
459 460 461 462
   The first member of the structure is a type code from this set.
   The enum values are arbitrary, but we'll use large numbers to make it
   more likely that we'll spot the error if a random word in memory is
   mistakenly interpreted as a Lisp_Misc.  */
463 464
enum Lisp_Misc_Type
  {
465
    Lisp_Misc_Free = 0x5eab,
466
    Lisp_Misc_Marker,
467
    Lisp_Misc_Overlay,
468
    Lisp_Misc_Save_Value,
469
    Lisp_Misc_Finalizer,
470 471 472
#ifdef HAVE_MODULES
    Lisp_Misc_User_Ptr,
#endif
473 474
    /* This is not a type code.  It is for range checking.  */
    Lisp_Misc_Limit
475 476
  };

477 478 479 480 481 482 483 484 485
/* 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
486
    Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
487 488
  };

489 490
/* If you want to define a new Lisp data type, here are some
   instructions.  See the thread at
491
   https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html
492 493 494 495 496
   for more info.

   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
   displayed to users.  These are Lisp_Save_Value, a Lisp_Misc
Paul Eggert's avatar
Paul Eggert committed
497
   subtype; and PVEC_OTHER, a kind of vectorlike object.  The former
498
   is suitable for temporarily stashing away pointers and integers in
499
   a Lisp object.  The latter is useful for vector-like Lisp objects
500 501 502 503 504 505 506 507 508 509
   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.

   To define a new data type, add one more Lisp_Misc subtype or one
   more pseudovector subtype.  Pseudovectors are more suitable for
   objects with several slots that need to support fast random access,
Paul Eggert's avatar
Paul Eggert committed
510
   while Lisp_Misc types are for everything else.  A pseudovector object
511 512 513 514
   provides one or more slots for Lisp objects, followed by struct
   members that are accessible only from C.  A Lisp_Misc object is a
   wrapper for a C struct that can contain anything you like.

515 516 517 518
   Explicit freeing is discouraged for Lisp objects in general.  But if
   you really need to exploit this, use Lisp_Misc (check free_misc in
   alloc.c to see why).  There is no way to free a vectorlike object.

519 520 521 522
   To add a new pseudovector type, extend the pvec_type enumeration;
   to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration.

   For a Lisp_Misc, you will also need to add your entry to union
Eli Zaretskii's avatar
Eli Zaretskii committed
523
   Lisp_Misc, but make sure the first word has the same structure as
524
   the others, starting with a 16-bit member of the Lisp_Misc_Type
Eli Zaretskii's avatar
Eli Zaretskii committed
525 526 527 528 529 530
   enumeration and a 1-bit GC markbit.  Also make sure the overall
   size of the union is not increased by your addition.  The latter
   requirement is to keep Lisp_Misc objects small enough, so they
   are handled faster: since all Lisp_Misc types use the same space,
   enlarging any of them will affect all the rest.  If you really
   need a larger object, it is best to use Lisp_Vectorlike instead.
531

532 533 534 535
   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).

536 537 538 539 540 541 542 543 544 545 546
   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
   several disparate C structures.  */

547
#ifdef CHECK_LISP_OBJECT_TYPE
Jim Blandy's avatar
Jim Blandy committed
548

549
typedef struct Lisp_Object { EMACS_INT i; } Lisp_Object;
Jim Blandy's avatar
Jim Blandy committed
550

551
#define LISP_INITIALLY(i) {i}
Jim Blandy's avatar
Jim Blandy committed
552

Paul Eggert's avatar
Paul Eggert committed
553
#undef CHECK_LISP_OBJECT_TYPE
554
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
555
#else /* CHECK_LISP_OBJECT_TYPE */
Jim Blandy's avatar
Jim Blandy committed
556

557
/* If a struct type is not wanted, define Lisp_Object as just a number.  */
Jim Blandy's avatar
Jim Blandy committed
558

559
typedef EMACS_INT Lisp_Object;
560
#define LISP_INITIALLY(i) (i)
561
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
562
#endif /* CHECK_LISP_OBJECT_TYPE */
563 564

/* Forward declarations.  */
Jim Blandy's avatar
Jim Blandy committed
565

566 567 568 569 570 571 572
/* Defined in this file.  */
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
					      Lisp_Object);

/* 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
573

574
/* Defined in data.c.  */
575
extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object);
Noam Postavsky's avatar
Noam Postavsky committed
576

577

578 579 580
#ifdef CANNOT_DUMP
enum { might_dump = false };
#elif defined DOUG_LEA_MALLOC
581 582
/* Defined in emacs.c.  */
extern bool might_dump;
583
#endif
584 585 586 587 588 589 590
/* True means Emacs has already been initialized.
   Used during startup to detect startup of dumped Emacs.  */
extern bool initialized;

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

591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640

/* Low-level conversion and type checking.  */

/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
   At the machine level, these operations are no-ops.  */

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

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

/* 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
}

INLINE void
(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x)
{
  lisp_h_CHECK_TYPE (ok, predicate, x);
}

/* Extract A's pointer value, assuming A's type is TYPE.  */

INLINE void *
(XUNTAG) (Lisp_Object a, int type)
{
#if USE_LSB_TAG
  return lisp_h_XUNTAG (a, type);
#else
  intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK;
  return (void *) i;
#endif
}

641 642

/* Interned state of a symbol.  */
643

644 645 646 647 648 649
enum symbol_interned
{
  SYMBOL_UNINTERNED = 0,
  SYMBOL_INTERNED = 1,
  SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
};
650

651 652 653 654 655 656 657 658
enum symbol_redirect
{
  SYMBOL_PLAINVAL  = 4,
  SYMBOL_VARALIAS  = 1,
  SYMBOL_LOCALIZED = 2,
  SYMBOL_FORWARDED = 3
};

Noam Postavsky's avatar
Noam Postavsky committed
659 660 661 662 663 664 665
enum symbol_trapped_write
{
  SYMBOL_UNTRAPPED_WRITE = 0,
  SYMBOL_NOWRITE = 1,
  SYMBOL_TRAPPED_WRITE = 2
};

666 667
struct Lisp_Symbol
{
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
  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;
711

712 713
      /* The symbol's property list.  */
      Lisp_Object plist;
714

715 716 717 718 719
      /* Next symbol in obarray bucket, if the symbol is interned.  */
      struct Lisp_Symbol *next;
    } s;
    char alignas (GCALIGNMENT) gcaligned;
  } u;
720
};
721
verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747

/* 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)

748 749 750 751 752
/* Yield a signed integer that contains TAG along with PTR.

   Sign-extend pointers when USE_LSB_TAG (this simplifies emacs-module.c),
   and zero-extend otherwise (that’s a bit faster here).
   Sign extension matters only when EMACS_INT is wider than a pointer.  */
753
#define TAG_PTR(tag, ptr) \
754 755 756
  (USE_LSB_TAG \
   ? (intptr_t) (ptr) + (tag) \
   : (EMACS_INT) (((EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)))
757

Paul Eggert's avatar
Paul Eggert committed
758 759
/* Yield an integer that contains a symbol tag along with OFFSET.
   OFFSET should be the offset in bytes from 'lispsym' to the symbol.  */
760
#define TAG_SYMOFFSET(offset) TAG_PTR (Lisp_Symbol, offset)
Paul Eggert's avatar
Paul Eggert committed
761

762 763 764 765 766
/* XLI_BUILTIN_LISPSYM (iQwhatever) is equivalent to
   XLI (builtin_lisp_symbol (Qwhatever)),
   except the former expands to an integer constant expression.  */
#define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym)

767 768 769 770
/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
   designed for use as an initializer, even for a constant initializer.  */
#define LISPSYM_INITIALLY(name) LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))

771 772
/* Declare extern constants for Lisp symbols.  These can be helpful
   when using a debugger like GDB, on older platforms where the debug
Paul Eggert's avatar
Paul Eggert committed
773
   format does not represent C macros.  */
774 775
#define DEFINE_LISP_SYMBOL(name) \
  DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
776
  DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
777

778 779 780 781
/* The index of the C-defined Lisp symbol SYM.
   This can be used in a static initializer.  */
#define SYMBOL_INDEX(sym) i##sym

782 783
/* 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
784
   define DEFINE_NON_NIL_Q_SYMBOL_MACROS to be false, to be portable to
785
   other Emacs instances that assign different values to Qt, etc.  */
Paul Eggert's avatar
Paul Eggert committed
786 787
#ifndef DEFINE_NON_NIL_Q_SYMBOL_MACROS
# define DEFINE_NON_NIL_Q_SYMBOL_MACROS true
788 789
#endif

790
#include "globals.h"
791

Tom Tromey's avatar
Tom Tromey committed
792 793 794
/* 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
795
   and PSEUDOVECTORP cast their pointers to union vectorlike_header *,
Tom Tromey's avatar
Tom Tromey committed
796 797
   because when two such pointers potentially alias, a compiler won't
   incorrectly reorder loads and stores to their size fields.  See
Ken Raeburn's avatar
Ken Raeburn committed
798
   Bug#8546.  */
799
union vectorlike_header
Tom Tromey's avatar
Tom Tromey committed
800
  {
801
    /* The main member contains various pieces of information:
Tom Tromey's avatar
Tom Tromey committed
802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820
       - 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;
821
    char alignas (GCALIGNMENT) gcaligned;
Tom Tromey's avatar
Tom Tromey committed
822
  };
823
verify (alignof (union vectorlike_header) % GCALIGNMENT == 0);
Tom Tromey's avatar
Tom Tromey committed
824

825 826 827 828 829
INLINE bool
(SYMBOLP) (Lisp_Object x)
{
  return lisp_h_SYMBOLP (x);
}
Tom Tromey's avatar
Tom Tromey committed
830

831 832 833 834 835 836 837 838 839 840 841 842
INLINE struct Lisp_Symbol *
(XSYMBOL) (Lisp_Object a)
{
#if USE_LSB_TAG
  return lisp_h_XSYMBOL (a);
#else
  eassert (SYMBOLP (a));
  intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol);
  void *p = (char *) lispsym + i;
  return p;
#endif
}
843

844 845
INLINE Lisp_Object
make_lisp_symbol (struct Lisp_Symbol *sym)
846
{
847 848 849
  Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym));
  eassert (XSYMBOL (a) == sym);
  return a;
850 851 852
}

INLINE Lisp_Object
853
builtin_lisp_symbol (int index)
854
{
855
  return make_lisp_symbol (&lispsym[index]);
856 857 858 859 860
}

INLINE void
(CHECK_SYMBOL) (Lisp_Object x)
{
861
  lisp_h_CHECK_SYMBOL (x);
862
}
863

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

866
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
867
# define ARRAY_MARK_FLAG PTRDIFF_MIN
868
DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
869

870 871
/* In the size word of a struct Lisp_Vector, this bit means it's really
   some other vector-like object.  */
872
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
873
# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
874
DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
875

876
/* In a pseudovector, the size field actually contains a word with one
877 878
   PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
   with PVEC_TYPE_MASK to indicate the actual type.  */
879 880
enum pvec_type
{
881
  PVEC_NORMAL_VECTOR,
882 883 884 885 886 887 888 889 890 891
  PVEC_FREE,
  PVEC_PROCESS,
  PVEC_FRAME,
  PVEC_WINDOW,
  PVEC_BOOL_VECTOR,
  PVEC_BUFFER,
  PVEC_HASH_TABLE,
  PVEC_TERMINAL,
  PVEC_WINDOW_CONFIGURATION,
  PVEC_SUBR,
892
  PVEC_OTHER,            /* Should never be visible to Elisp code.  */
893 894
  PVEC_XWIDGET,
  PVEC_XWIDGET_VIEW,
895
  PVEC_THREAD,
896
  PVEC_MUTEX,
Tom Tromey's avatar
Tom Tromey committed
897
  PVEC_CONDVAR,
898
  PVEC_MODULE_FUNCTION,
899

900 901 902 903
  /* These should be last, check internal_equal to see why.  */
  PVEC_COMPILED,
  PVEC_CHAR_TABLE,
  PVEC_SUB_CHAR_TABLE,
904
  PVEC_RECORD,
905
  PVEC_FONT /* Should be last because it's used for range checking.  */
906
};
907

Paul Eggert's avatar
Paul Eggert committed
908
enum More_Lisp_Bits
909
  {
Paul Eggert's avatar
Paul Eggert committed
910 911 912 913 914
    /* 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.  */
915
    PSEUDOVECTOR_SIZE_BITS = 12,
916
    PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
917 918 919 920

    /* 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,
921
    PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
922 923 924 925
			      << 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
926
    PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
Paul Eggert's avatar
Paul Eggert committed
927
  };
Jim Blandy's avatar
Jim Blandy committed
928

929
/* These functions extract various sorts of values from a Lisp_Object.
930 931 932
   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.  */
Jim Blandy's avatar
Jim Blandy committed
933

934 935 936 937
/* Largest and smallest representable fixnum values.  These are the C
   values.  They are macros for use in static initializers.  */
#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
Kenichi Handa's avatar
Kenichi Handa committed
938

939
#if USE_LSB_TAG
Kenichi Handa's avatar
Kenichi Handa committed
940

941 942 943 944 945 946 947 948 949 950 951 952 953 954 955
INLINE Lisp_Object
(make_number) (EMACS_INT n)
{
  return lisp_h_make_number (n);
}

INLINE EMACS_INT
(XINT) (Lisp_Object a)
{
  return lisp_h_XINT (a);
}

INLINE EMACS_INT
(XFASTINT) (Lisp_Object a)
{
956 957 958
  EMACS_INT n = lisp_h_XFASTINT (a);
  eassume (0 <= n);
  return n;
959 960
}

961
#else /* ! USE_LSB_TAG */
Jim Blandy's avatar
Jim Blandy committed
962

963 964 965
/* Although compiled only if ! USE_LSB_TAG, the following functions
   also work when USE_LSB_TAG; this is to aid future maintenance when
   the lisp_h_* macros are eventually removed.  */
Jim Blandy's avatar
Jim Blandy committed
966

967 968
/* Make a Lisp integer representing the value of the low order
   bits of N.  */
Paul Eggert's avatar
Paul Eggert committed
969
INLINE Lisp_Object
970 971
make_number (EMACS_INT n)
{
972
  EMACS_INT int0 = Lisp_Int0;
973 974 975 976
  if (USE_LSB_TAG)
    {
      EMACS_UINT u = n;
      n = u << INTTYPEBITS;
977
      n += int0;
978 979
    }
  else
980 981 982 983
    {
      n &= INTMASK;
      n += (int0 << VALBITS);
    }
984
  return XIL (n);
985
}
Jim Blandy's avatar
Jim Blandy committed
986

987
/* Extract A's value as a signed integer.  */
Paul Eggert's avatar
Paul Eggert committed
988
INLINE EMACS_INT
989 990 991
XINT (Lisp_Object a)
{
  EMACS_INT i = XLI (a);
992 993 994 995 996 997
  if (! USE_LSB_TAG)
    {
      EMACS_UINT u = i;
      i = u << INTTYPEBITS;
    }
  return i >> INTTYPEBITS;
998
}
Jim Blandy's avatar
Jim Blandy committed
999

1000 1001 1002
/* Like XINT (A), but may be faster.  A must be nonnegative.
   If ! USE_LSB_TAG, this takes advantage of the fact that Lisp
   integers have zero-bits in their tags.  */
Paul Eggert's avatar
Paul Eggert committed
1003
INLINE EMACS_INT
1004 1005
XFASTINT (Lisp_Object a)
{
1006 1007
  EMACS_INT int0 = Lisp_Int0;
  EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS);
1008
  eassume (0 <= n);
1009 1010
  return n;
}
1011

1012
#endif /* ! USE_LSB_TAG */
1013

1014
/* Extract A's value as an unsigned integer.  */
Paul Eggert's avatar
Paul Eggert committed
1015
INLINE EMACS_UINT
1016 1017 1018 1019 1020
XUINT (Lisp_Object a)
{
  EMACS_UINT i = XLI (a);
  return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
}
1021

1022 1023 1024
/* Return A's (Lisp-integer sized) hash.  Happens to be like XUINT
   right now, but XUINT should only be applied to objects we know are
   integers.  */
1025 1026 1027 1028 1029 1030

INLINE EMACS_INT
(XHASH) (Lisp_Object a)
{
  return lisp_h_XHASH (a);
}
1031

1032
/* Like make_number (N), but may be faster.  N must be in nonnegative range.  */
Paul Eggert's avatar
Paul Eggert committed
1033
INLINE Lisp_Object
1034 1035 1036
make_natnum (EMACS_INT n)
{
  eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
1037 1038
  EMACS_INT int0 = Lisp_Int0;
  return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS));
1039
}
1040

1041
/* Return true if X and Y are the same object.  */
1042 1043 1044 1045 1046 1047

INLINE bool
(EQ) (Lisp_Object x, Lisp_Object y)
{
  return lisp_h_EQ (x, y);
}
1048

1049
/* True if the possibly-unsigned integer I doesn't fit in a Lisp fixnum.  */
1050 1051

#define FIXNUM_OVERFLOW_P(i) \
1052
  (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
1053

Paul Eggert's avatar
Paul Eggert committed
1054
INLINE ptrdiff_t
1055 1056 1057 1058
clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
{
  return num < lower ? lower : num <= upper ? num : upper;
}
1059

1060
/* Construct a Lisp_Object from a value or address.  */
1061

Paul Eggert's avatar
Paul Eggert committed
1062
INLINE Lisp_Object
1063 1064
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
1065
  Lisp_Object a = XIL (TAG_PTR (type, ptr));
1066 1067 1068 1069
  eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
  return a;
}

1070 1071
INLINE bool
(INTEGERP) (Lisp_Object x)
Paul Eggert's avatar
Paul Eggert committed
1072
{
1073
  return lisp_h_INTEGERP (x);
Paul Eggert's avatar
Paul Eggert committed
1074 1075
}

Paul Eggert's avatar
Paul Eggert committed
1076
#define XSETINT(a, b) ((a) = make_number (b))
1077
#define XSETFASTINT(a, b) ((a) = make_natnum (b))
Paul Eggert's avatar
Paul Eggert committed
1078 1079 1080
#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
1081
#define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b))
Paul Eggert's avatar
Paul Eggert committed
1082 1083
#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
1084 1085

/* Pseudovector types.  */
1086

1087 1088 1089
#define XSETPVECTYPE(v, code)						\
  ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))
#define XSETPVECTYPESIZE(v, code, lispsize, restsize)		\
1090
  ((v)->header.size = (PSEUDOVECTOR_FLAG			\
1091 1092 1093
		       | ((code) << PSEUDOVECTOR_AREA_BITS)	\
		       | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \
		       | (lispsize)))
1094

1095
/* The cast to union vectorlike_header * avoids aliasing issues.  */
1096
#define XSETPSEUDOVECTOR(a, b, code) \
1097
  XSETTYPED_PSEUDOVECTOR (a, b,					\
1098
			  (((union vectorlike_header *)	\
1099 1100 1101
			    XUNTAG (a, Lisp_Vectorlike))	\
			   ->size),				\
			  code)
1102
#define XSETTYPED_PSEUDOVECTOR(a, b, size, code)			\
1103
  (XSETVECTOR (a, b),							\
1104
   eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))		\
1105
	    == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
1106

1107 1108 1109 1110
#define XSETWINDOW_CONFIGURATION(a, b) \
  (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
1111
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
1112
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
1113
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
1114
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
1115 1116
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
1117
#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
1118
#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD))
1119
#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX))
Tom Tromey's avatar
Tom Tromey committed
1120
#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR))
1121

1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140
/* Efficiently convert a pointer to a Lisp object and back.  The
   pointer is represented as a Lisp integer, so the garbage collector
   does not know about it.  The pointer should not have both Lisp_Int1
   bits set, which makes this conversion inherently unportable.  */

INLINE void *
XINTPTR (Lisp_Object a)
{
  return XUNTAG (a, Lisp_Int0);
}

INLINE Lisp_Object
make_pointer_integer (void *p)
{
  Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p));
  eassert (INTEGERP (a) && XINTPTR (a) == p);
  return a;
}

1141
/* See the macros in intervals.h.  */
1142 1143 1144

typedef struct interval *INTERVAL;

1145 1146 1147
struct Lisp_Cons
{
  union
Jim Blandy's avatar
Jim Blandy committed
1148
  {
1149
    struct
1150
    {
1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166
      /* Car of this cons cell.  */
      Lisp_Object car;

      union
      {
	/* Cdr of this cons cell.  */
	Lisp_Object cdr;

	/* Used to chain conses on a free list.  */
	struct Lisp_Cons *chain;
      } u;
    } s;
    char alignas (GCALIGNMENT) gcaligned;
  } u;
};
verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0);
Jim Blandy's avatar
Jim Blandy committed
1167

1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195
INLINE bool
(NILP) (Lisp_Object x)
{
  return lisp_h_NILP (x);
}

INLINE bool
(CONSP) (Lisp_Object x)
{
  return lisp_h_CONSP (x);
}

INLINE void
CHECK_CONS (Lisp_Object x)
{
  CHECK_TYPE (CONSP (x), Qconsp, x);
}

INLINE struct Lisp_Cons *
(XCONS) (Lisp_Object a)
{
  return lisp_h_XCONS (a);
}

/* Take the car or cdr of something known to be a cons cell.  */
/* The _addr functions shouldn't be used outside of the minimal set
   of code that has to know what a cons cell looks like.  Other code not
   part of the basic lisp implementation should assume that the car and cdr