1 /* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*-
2 
3 Copyright (C) 1985-1987, 1993-1995, 1997-2021 Free Software Foundation,
4 Inc.
5 
6 This file is part of GNU Emacs.
7 
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
12 
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 GNU General Public License for more details.
17 
18 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/>.  */
20 
21 #ifndef EMACS_LISP_H
22 #define EMACS_LISP_H
23 
24 #include <alloca.h>
25 #include <setjmp.h>
26 #include <stdalign.h>
27 #include <stdarg.h>
28 #include <stddef.h>
29 #include <string.h>
30 #include <float.h>
31 #include <inttypes.h>
32 #include <limits.h>
33 
34 #include <intprops.h>
35 #include <verify.h>
36 
37 INLINE_HEADER_BEGIN
38 
39 /* Define a TYPE constant ID as an externally visible name.  Use like this:
40 
41       DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
42       # define ID (some integer preprocessor expression of type TYPE)
43       DEFINE_GDB_SYMBOL_END (ID)
44 
45    This hack is for the benefit of compilers that do not make macro
46    definitions or enums visible to the debugger.  It's used for symbols
47    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 # define DEFINE_GDB_SYMBOL_END(id) = id;
53 #else
54 # define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
55 # define DEFINE_GDB_SYMBOL_END(val) ;
56 #endif
57 
58 /* The ubiquitous max and min macros.  */
59 #undef min
60 #undef max
61 #define max(a, b) ((a) > (b) ? (a) : (b))
62 #define min(a, b) ((a) < (b) ? (a) : (b))
63 
64 /* Number of elements in an array.  */
65 #define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0])
66 
67 /* Number of bits in a Lisp_Object tag.  */
68 DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
69 #define GCTYPEBITS 3
70 DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
71 
72 /* EMACS_INT - signed integer wide enough to hold an Emacs value
73    EMACS_INT_WIDTH - width in bits of EMACS_INT
74    EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
75    pI - printf length modifier for EMACS_INT
76    EMACS_UINT - unsigned variant of EMACS_INT */
77 #ifndef EMACS_INT_MAX
78 # if INTPTR_MAX <= 0
79 #  error "INTPTR_MAX misconfigured"
80 # elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
81 typedef int EMACS_INT;
82 typedef unsigned int EMACS_UINT;
83 enum { EMACS_INT_WIDTH = INT_WIDTH, EMACS_UINT_WIDTH = UINT_WIDTH };
84 #  define EMACS_INT_MAX INT_MAX
85 #  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 };
90 #  define EMACS_INT_MAX LONG_MAX
91 #  define pI "l"
92 # elif INTPTR_MAX <= LLONG_MAX
93 typedef long long int EMACS_INT;
94 typedef unsigned long long int EMACS_UINT;
95 enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH };
96 #  define EMACS_INT_MAX LLONG_MAX
97 /* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero,
98    which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or
99    later and the runtime version is 5.0.0 or later.  Otherwise,
100    printf-like functions are declared with __ms_printf__ attribute,
101    which will cause a warning for %lld etc.  */
102 #  if defined __MINGW32__						\
103   && (!defined __USE_MINGW_ANSI_STDIO					\
104       || (!defined MINGW_W64						\
105 	  && !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)))
106 #   define pI "I64"
107 #  else	 /* ! MinGW */
108 #   define pI "ll"
109 #  endif
110 # else
111 #  error "INTPTR_MAX too large"
112 # endif
113 #endif
114 
115 /* Number of bits to put in each character in the internal representation
116    of bool vectors.  This should not vary across implementations.  */
117 enum {  BOOL_VECTOR_BITS_PER_CHAR =
118 #define BOOL_VECTOR_BITS_PER_CHAR 8
119         BOOL_VECTOR_BITS_PER_CHAR
120 };
121 
122 /* An unsigned integer type representing a fixed-length bit sequence,
123    suitable for bool vector words, GC mark bits, etc.  Normally it is size_t
124    for speed, but on weird platforms it is unsigned char and not all
125    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 #else
131 typedef unsigned char bits_word;
132 # define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
133 enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
134 #endif
135 verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
136 
137 /* Use pD to format ptrdiff_t values, which suffice for indexes into
138    buffers and strings.  Emacs never allocates objects larger than
139    PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
140    In C99, pD can always be "t"; configure it here for the sake of
141    pre-C99 libraries such as glibc 2.0 and Solaris 8.  */
142 #if PTRDIFF_MAX == INT_MAX
143 # define pD ""
144 #elif PTRDIFF_MAX == LONG_MAX
145 # define pD "l"
146 #elif PTRDIFF_MAX == LLONG_MAX
147 # define pD "ll"
148 #else
149 # define pD "t"
150 #endif
151 
152 /* Convenience macro for rarely-used functions that do not return.  */
153 #define AVOID _Noreturn ATTRIBUTE_COLD void
154 
155 /* Extra internal type checking?  */
156 
157 /* Define Emacs versions of <assert.h>'s 'assert (COND)' and <verify.h>'s
158    'assume (COND)'.  COND should be free of side effects, as it may or
159    may not be evaluated.
160 
161    'eassert (COND)' checks COND at runtime if ENABLE_CHECKING is
162    defined and suppress_checking is false, and does nothing otherwise.
163    Emacs dies if COND is checked and is false.  The suppress_checking
164    variable is initialized to 0 in alloc.c.  Set it to 1 using a
165    debugger to temporarily disable aborting on detected internal
166    inconsistencies or error conditions.
167 
168    In some cases, a good compiler may be able to optimize away the
169    eassert macro even if ENABLE_CHECKING is true, e.g., if XSTRING (x)
170    uses eassert to test STRINGP (x), but a particular use of XSTRING
171    is invoked only after testing that STRINGP (x) is true, making the
172    test redundant.
173 
174    eassume is like eassert except that it also causes the compiler to
175    assume that COND is true afterwards, regardless of whether runtime
176    checking is enabled.  This can improve performance in some cases,
177    though it can degrade performance in others.  It's often suboptimal
178    for COND to call external functions or access volatile storage.  */
179 
180 #ifndef ENABLE_CHECKING
181 # define eassert(cond) ((void) (false && (cond))) /* Check COND compiles.  */
182 # define eassume(cond) assume (cond)
183 #else /* ENABLE_CHECKING */
184 
185 extern AVOID die (const char *, const char *, int);
186 
187 extern bool suppress_checking EXTERNALLY_VISIBLE;
188 
189 # define eassert(cond)						\
190    (suppress_checking || (cond) 				\
191     ? (void) 0							\
192     : die (# cond, __FILE__, __LINE__))
193 # define eassume(cond)						\
194    (suppress_checking						\
195     ? assume (cond)						\
196     : (cond)							\
197     ? (void) 0							\
198     : die (# cond, __FILE__, __LINE__))
199 #endif /* ENABLE_CHECKING */
200 
201 
202 /* Use the configure flag --enable-check-lisp-object-type to make
203    Lisp_Object use a struct type instead of the default int.  The flag
204    causes CHECK_LISP_OBJECT_TYPE to be defined.  */
205 
206 /***** Select the tagging scheme.  *****/
207 /* The following option controls the tagging scheme:
208    - USE_LSB_TAG means that we can assume the least 3 bits of pointers are
209      always 0, and we can thus use them to hold tag bits, without
210      restricting our addressing space.
211 
212    If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
213    restricting our possible address range.
214 
215    USE_LSB_TAG not only requires the least 3 bits of pointers returned by
216    malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
217    on some non-GC Lisp_Objects, all of which are aligned via
218    GCALIGNED_UNION_MEMBER.  */
219 
220 enum Lisp_Bits
221   {
222     /* Number of bits in a Lisp_Object value, not counting the tag.  */
223     VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
224 
225     /* Number of bits in a fixnum value, not counting the tag.  */
226     FIXNUM_BITS = VALBITS + 1
227   };
228 
229 /* Number of bits in a fixnum tag; can be used in #if.  */
230 DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS)
231 #define INTTYPEBITS (GCTYPEBITS - 1)
232 DEFINE_GDB_SYMBOL_END (INTTYPEBITS)
233 
234 /* The maximum value that can be stored in a EMACS_INT, assuming all
235    bits other than the type bits contribute to a nonnegative signed value.
236    This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an
237    expression involving VAL_MAX.  */
238 #define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
239 
240 /* Whether the least-significant bits of an EMACS_INT contain the tag.
241    On hosts where pointers-as-ints do not exceed VAL_MAX / 2, USE_LSB_TAG is:
242     a. unnecessary, because the top bits of an EMACS_INT are unused, and
243     b. slower, because it typically requires extra masking.
244    So, USE_LSB_TAG is true only on hosts where it might be useful.  */
245 DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
246 #define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
247 DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
248 
249 /* Mask for the value (as opposed to the type bits) of a Lisp object.  */
250 DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
251 # define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
252 DEFINE_GDB_SYMBOL_END (VALMASK)
253 
254 #if !USE_LSB_TAG && !defined WIDE_EMACS_INT
255 # error "USE_LSB_TAG not supported on this platform; please report this." \
256 	"Try 'configure --with-wide-int' to work around the problem."
257 error !;
258 #endif
259 
260 /* Minimum alignment requirement for Lisp objects, imposed by the
261    internal representation of tagged pointers.  It is 2**GCTYPEBITS if
262    USE_LSB_TAG, 1 otherwise.  It must be a literal integer constant,
263    for older versions of GCC (through at least 4.9).  */
264 #if USE_LSB_TAG
265 # define GCALIGNMENT 8
266 # if GCALIGNMENT != 1 << GCTYPEBITS
267 #  error "GCALIGNMENT and GCTYPEBITS are inconsistent"
268 # endif
269 #else
270 # define GCALIGNMENT 1
271 #endif
272 
273 /* To cause a union to have alignment of at least GCALIGNMENT, put
274    GCALIGNED_UNION_MEMBER in its member list.
275 
276    If a struct is always GC-aligned (either by the GC, or via
277    allocation in a containing union that has GCALIGNED_UNION_MEMBER)
278    and does not contain a GC-aligned struct or union, putting
279    GCALIGNED_STRUCT after its closing '}' can help the compiler
280    generate better code.
281 
282    Although these macros are reasonably portable, they are not
283    guaranteed on non-GCC platforms, as C11 does not require support
284    for alignment to GCALIGNMENT and older compilers may ignore
285    alignment requests.  For any type T where garbage collection
286    requires alignment, use verify (GCALIGNED (T)) to verify the
287    requirement on the current platform.  Types need this check if
288    their objects can be allocated outside the garbage collector.  For
289    example, struct Lisp_Symbol needs the check because of lispsym and
290    struct Lisp_Cons needs it because of STACK_CONS.  */
291 
292 #define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned;
293 #if HAVE_STRUCT_ATTRIBUTE_ALIGNED
294 # define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT)))
295 #else
296 # define GCALIGNED_STRUCT
297 #endif
298 #define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0)
299 
300 /* Lisp_Word is a scalar word suitable for holding a tagged pointer or
301    integer.  Usually it is a pointer to a deliberately-incomplete type
302    'union Lisp_X'.  However, it is EMACS_INT when Lisp_Objects and
303    pointers differ in width.  */
304 
305 #define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
306 #if LISP_WORDS_ARE_POINTERS
307 typedef union Lisp_X *Lisp_Word;
308 #else
309 typedef EMACS_INT Lisp_Word;
310 #endif
311 
312 /* Some operations are so commonly executed that they are implemented
313    as macros, not functions, because otherwise runtime performance would
314    suffer too much when compiling with GCC without optimization.
315    There's no need to inline everything, just the operations that
316    would otherwise cause a serious performance problem.
317 
318    For each such operation OP, define a macro lisp_h_OP that contains
319    the operation's implementation.  That way, OP can be implemented
320    via a macro definition like this:
321 
322      #define OP(x) lisp_h_OP (x)
323 
324    and/or via a function definition like this:
325 
326      Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); }
327 
328    without worrying about the implementations diverging, since
329    lisp_h_OP defines the actual implementation.  The lisp_h_OP macros
330    are intended to be private to this include file, and should not be
331    used elsewhere.
332 
333    FIXME: Remove the lisp_h_OP macros, and define just the inline OP
334    functions, once "gcc -Og" (new to GCC 4.8) works well enough for
335    Emacs developers.  Maybe in the year 2020.  See Bug#11935.
336 
337    For the macros that have corresponding functions (defined later),
338    see these functions for commentary.  */
339 
340 /* Convert among the various Lisp-related types: I for EMACS_INT, L
341    for Lisp_Object, P for void *.  */
342 #if !CHECK_LISP_OBJECT_TYPE
343 # if LISP_WORDS_ARE_POINTERS
344 #  define lisp_h_XLI(o) ((EMACS_INT) (o))
345 #  define lisp_h_XIL(i) ((Lisp_Object) (i))
346 #  define lisp_h_XLP(o) ((void *) (o))
347 #  define lisp_h_XPL(p) ((Lisp_Object) (p))
348 # else
349 #  define lisp_h_XLI(o) (o)
350 #  define lisp_h_XIL(i) (i)
351 #  define lisp_h_XLP(o) ((void *) (uintptr_t) (o))
352 #  define lisp_h_XPL(p) ((Lisp_Object) (uintptr_t) (p))
353 # endif
354 #else
355 # if LISP_WORDS_ARE_POINTERS
356 #  define lisp_h_XLI(o) ((EMACS_INT) (o).i)
357 #  define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)})
358 #  define lisp_h_XLP(o) ((void *) (o).i)
359 #  define lisp_h_XPL(p) lisp_h_XIL (p)
360 # else
361 #  define lisp_h_XLI(o) ((o).i)
362 #  define lisp_h_XIL(i) ((Lisp_Object) {i})
363 #  define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i)
364 #  define lisp_h_XPL(p) ((Lisp_Object) {(uintptr_t) (p)})
365 # endif
366 #endif
367 
368 #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
369 #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
370 #define lisp_h_CHECK_TYPE(ok, predicate, x) \
371    ((ok) ? (void) 0 : wrong_type_argument (predicate, x))
372 #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
373 #define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
374 #define lisp_h_FIXNUMP(x) \
375    (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
376 	- (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \
377        & ((1 << INTTYPEBITS) - 1)))
378 #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
379 #define lisp_h_NILP(x) EQ (x, Qnil)
380 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
381    (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
382     (sym)->u.s.val.value = (v))
383 #define lisp_h_SYMBOL_CONSTANT_P(sym) \
384    (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
385 #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
386 #define lisp_h_SYMBOL_VAL(sym) \
387    (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
388 #define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol)
389 #define lisp_h_TAGGEDP(a, tag) \
390    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
391 	- (unsigned) (tag)) \
392        & ((1 << GCTYPEBITS) - 1)))
393 #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
394 #define lisp_h_XCAR(c) XCONS (c)->u.s.car
395 #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
396 #define lisp_h_XCONS(a) \
397    (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
398 #define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
399 #if USE_LSB_TAG
400 # define lisp_h_make_fixnum_wrap(n) \
401     XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
402 # if defined HAVE_STATEMENT_EXPRESSIONS && defined HAVE_TYPEOF
403 #  define lisp_h_make_fixnum(n) \
404      ({ typeof (+(n)) lisp_h_make_fixnum_n = n; \
405 	eassert (!FIXNUM_OVERFLOW_P (lisp_h_make_fixnum_n)); \
406 	lisp_h_make_fixnum_wrap (lisp_h_make_fixnum_n); })
407 # else
408 #  define lisp_h_make_fixnum(n) lisp_h_make_fixnum_wrap (n)
409 # endif
410 # define lisp_h_XFIXNUM_RAW(a) (XLI (a) >> INTTYPEBITS)
411 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
412 #endif
413 
414 /* When compiling via gcc -O0, define the key operations as macros, as
415    Emacs is too slow otherwise.  To disable this optimization, compile
416    with -DINLINING=false.  */
417 #if (defined __NO_INLINE__ \
418      && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
419      && ! (defined INLINING && ! INLINING))
420 # define DEFINE_KEY_OPS_AS_MACROS true
421 #else
422 # define DEFINE_KEY_OPS_AS_MACROS false
423 #endif
424 
425 #if DEFINE_KEY_OPS_AS_MACROS
426 # define XLI(o) lisp_h_XLI (o)
427 # define XIL(i) lisp_h_XIL (i)
428 # define XLP(o) lisp_h_XLP (o)
429 # define XPL(p) lisp_h_XPL (p)
430 # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x)
431 # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
432 # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
433 # define CONSP(x) lisp_h_CONSP (x)
434 # define EQ(x, y) lisp_h_EQ (x, y)
435 # define FLOATP(x) lisp_h_FLOATP (x)
436 # define FIXNUMP(x) lisp_h_FIXNUMP (x)
437 # define NILP(x) lisp_h_NILP (x)
438 # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
439 # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
440 # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
441 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
442 # define SYMBOLP(x) lisp_h_SYMBOLP (x)
443 # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
444 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
445 # define XCAR(c) lisp_h_XCAR (c)
446 # define XCDR(c) lisp_h_XCDR (c)
447 # define XCONS(a) lisp_h_XCONS (a)
448 # define XHASH(a) lisp_h_XHASH (a)
449 # if USE_LSB_TAG
450 #  define make_fixnum(n) lisp_h_make_fixnum (n)
451 #  define XFIXNUM_RAW(a) lisp_h_XFIXNUM_RAW (a)
452 #  define XTYPE(a) lisp_h_XTYPE (a)
453 # endif
454 #endif
455 
456 
457 /* Define the fundamental Lisp data structures.  */
458 
459 /* This is the set of Lisp data types.  If you want to define a new
460    data type, read the comments after Lisp_Fwd_Type definition
461    below.  */
462 
463 /* Fixnums use 2 tags, to give them one extra bit, thus
464    extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1.  */
465 #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
466 #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
467 
468 /* Idea stolen from GDB.  Pedantic GCC complains about enum bitfields,
469    and xlc and Oracle Studio c99 complain vociferously about them.  */
470 #if (defined __STRICT_ANSI__ || defined __IBMC__ \
471      || (defined __SUNPRO_C && __STDC__))
472 #define ENUM_BF(TYPE) unsigned int
473 #else
474 #define ENUM_BF(TYPE) enum TYPE
475 #endif
476 
477 
478 enum Lisp_Type
479   {
480     /* Symbol.  XSYMBOL (object) points to a struct Lisp_Symbol.  */
481     Lisp_Symbol = 0,
482 
483     /* Type 1 is currently unused.  */
484 
485     /* Fixnum.  XFIXNUM (obj) is the integer value.  */
486     Lisp_Int0 = 2,
487     Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
488 
489     /* String.  XSTRING (object) points to a struct Lisp_String.
490        The length of the string, and its contents, are stored therein.  */
491     Lisp_String = 4,
492 
493     /* Vector of Lisp objects, or something resembling it.
494        XVECTOR (object) points to a struct Lisp_Vector, which contains
495        the size and contents.  The size field also contains the type
496        information, if it's not a real vector object.  */
497     Lisp_Vectorlike = 5,
498 
499     /* Cons.  XCONS (object) points to a struct Lisp_Cons.  */
500     Lisp_Cons = USE_LSB_TAG ? 3 : 6,
501 
502     /* Must be last entry in Lisp_Type enumeration.  */
503     Lisp_Float = 7
504   };
505 
506 /* These are the types of forwarding objects used in the value slot
507    of symbols for special built-in variables whose value is stored in
508    C variables.  */
509 enum Lisp_Fwd_Type
510   {
511     Lisp_Fwd_Int,		/* Fwd to a C `int' variable.  */
512     Lisp_Fwd_Bool,		/* Fwd to a C boolean var.  */
513     Lisp_Fwd_Obj,		/* Fwd to a C Lisp_Object variable.  */
514     Lisp_Fwd_Buffer_Obj,	/* Fwd to a Lisp_Object field of buffers.  */
515     Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
516   };
517 
518 /* If you want to define a new Lisp data type, here are some
519    instructions.
520 
521    First, there are already a couple of Lisp types that can be used if
522    your new type does not need to be exposed to Lisp programs nor
523    displayed to users.  These are Lisp_Misc_Ptr and PVEC_OTHER,
524    which are both vectorlike objects.  The former
525    is suitable for stashing a pointer in a Lisp object; the pointer
526    might be to some low-level C object that contains auxiliary
527    information.  The latter is useful for vector-like Lisp objects
528    that need to be used as part of other objects, but which are never
529    shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
530    an example).
531 
532    These two types don't look pretty when printed, so they are
533    unsuitable for Lisp objects that can be exposed to users.
534 
535    To define a new data type, add a pseudovector subtype by extending
536    the pvec_type enumeration.  A pseudovector provides one or more
537    slots for Lisp objects, followed by struct members that are
538    accessible only from C.
539 
540    There is no way to explicitly free a Lisp Object; only the garbage
541    collector frees them.
542 
543    For a new pseudovector, it's highly desirable to limit the size
544    of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c).
545    Otherwise you will need to change sweep_vectors (also in alloc.c).
546 
547    Then you will need to add switch branches in print.c (in
548    print_object, to print your object, and possibly also in
549    print_preprocess) and to alloc.c, to mark your object (in
550    mark_object) and to free it (in gc_sweep).  The latter is also the
551    right place to call any code specific to your data type that needs
552    to run when the object is recycled -- e.g., free any additional
553    resources allocated for it that are not Lisp objects.  You can even
554    make a pointer to the function that frees the resources a slot in
555    your object -- this way, the same object could be used to represent
556    several disparate C structures.
557 
558    You also need to add the new type to the constant
559    `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el.  */
560 
561 
562 /* A Lisp_Object is a tagged pointer or integer.  Ordinarily it is a
563    Lisp_Word.  However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper
564    around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'.
565 
566    LISP_INITIALLY (W) initializes a Lisp object with a tagged value
567    that is a Lisp_Word W.  It can be used in a static initializer.  */
568 
569 #ifdef CHECK_LISP_OBJECT_TYPE
570 typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
571 # define LISP_INITIALLY(w) {w}
572 # undef CHECK_LISP_OBJECT_TYPE
573 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
574 #else
575 typedef Lisp_Word Lisp_Object;
576 # define LISP_INITIALLY(w) (w)
577 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
578 #endif
579 
580 /* Forward declarations.  */
581 
582 /* Defined in this file.  */
583 INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
584 					      Lisp_Object);
585 
586 /* Defined in bignum.c.  */
587 extern double bignum_to_double (Lisp_Object);
588 extern Lisp_Object make_bigint (intmax_t);
589 extern Lisp_Object make_biguint (uintmax_t);
590 
591 /* Defined in chartab.c.  */
592 extern Lisp_Object char_table_ref (Lisp_Object, int);
593 extern void char_table_set (Lisp_Object, int, Lisp_Object);
594 
595 /* Defined in data.c.  */
596 extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
597 extern Lisp_Object default_value (Lisp_Object symbol);
598 
599 
600 /* Defined in emacs.c.  */
601 
602 /* Set after Emacs has started up the first time.
603    Prevents reinitialization of the Lisp world and keymaps on
604    subsequent starts.  */
605 extern bool initialized;
606 
607 extern struct gflags
608 {
609   /* True means this Emacs instance was born to dump.  */
610 #if defined HAVE_PDUMPER || defined HAVE_UNEXEC
611   bool will_dump_ : 1;
612   bool will_bootstrap_ : 1;
613 #endif
614 #ifdef HAVE_PDUMPER
615   /* Set in an Emacs process that will likely dump with pdumper; all
616      Emacs processes may dump with pdumper, however.  */
617   bool will_dump_with_pdumper_ : 1;
618   /* Set in an Emacs process that has been restored from a portable
619      dump.  */
620   bool dumped_with_pdumper_ : 1;
621 #endif
622 #ifdef HAVE_UNEXEC
623   bool will_dump_with_unexec_ : 1;
624   /* Set in an Emacs process that has been restored from an unexec
625      dump.  */
626   bool dumped_with_unexec_ : 1;
627   /* We promise not to unexec: useful for hybrid malloc.  */
628   bool will_not_unexec_ : 1;
629 #endif
630 } gflags;
631 
632 INLINE bool
will_dump_p(void)633 will_dump_p (void)
634 {
635 #if HAVE_PDUMPER || defined HAVE_UNEXEC
636   return gflags.will_dump_;
637 #else
638   return false;
639 #endif
640 }
641 
642 INLINE bool
will_bootstrap_p(void)643 will_bootstrap_p (void)
644 {
645 #if HAVE_PDUMPER || defined HAVE_UNEXEC
646   return gflags.will_bootstrap_;
647 #else
648   return false;
649 #endif
650 }
651 
652 INLINE bool
will_dump_with_pdumper_p(void)653 will_dump_with_pdumper_p (void)
654 {
655 #if HAVE_PDUMPER
656   return gflags.will_dump_with_pdumper_;
657 #else
658   return false;
659 #endif
660 }
661 
662 INLINE bool
dumped_with_pdumper_p(void)663 dumped_with_pdumper_p (void)
664 {
665 #if HAVE_PDUMPER
666   return gflags.dumped_with_pdumper_;
667 #else
668   return false;
669 #endif
670 }
671 
672 INLINE bool
will_dump_with_unexec_p(void)673 will_dump_with_unexec_p (void)
674 {
675 #ifdef HAVE_UNEXEC
676   return gflags.will_dump_with_unexec_;
677 #else
678   return false;
679 #endif
680 }
681 
682 INLINE bool
dumped_with_unexec_p(void)683 dumped_with_unexec_p (void)
684 {
685 #ifdef HAVE_UNEXEC
686   return gflags.dumped_with_unexec_;
687 #else
688   return false;
689 #endif
690 }
691 
692 /* This function is the opposite of will_dump_with_unexec_p(), except
693    that it returns false before main runs.  It's important to use
694    gmalloc for any pre-main allocations if we're going to unexec.  */
695 INLINE bool
definitely_will_not_unexec_p(void)696 definitely_will_not_unexec_p (void)
697 {
698 #ifdef HAVE_UNEXEC
699   return gflags.will_not_unexec_;
700 #else
701   return true;
702 #endif
703 }
704 
705 /* Defined in floatfns.c.  */
706 extern double extract_float (Lisp_Object);
707 
708 
709 /* Low-level conversion and type checking.  */
710 
711 /* Convert among various types use to implement Lisp_Object.  At the
712    machine level, these operations may widen or narrow their arguments
713    if pointers differ in width from EMACS_INT; otherwise they are
714    no-ops.  */
715 
EMACS_INT(XLI)716 INLINE EMACS_INT
717 (XLI) (Lisp_Object o)
718 {
719   return lisp_h_XLI (o);
720 }
721 
Lisp_Object(XIL)722 INLINE Lisp_Object
723 (XIL) (EMACS_INT i)
724 {
725   return lisp_h_XIL (i);
726 }
727 
728 INLINE void *
729 (XLP) (Lisp_Object o)
730 {
731   return lisp_h_XLP (o);
732 }
733 
Lisp_Object(XPL)734 INLINE Lisp_Object
735 (XPL) (void *p)
736 {
737   return lisp_h_XPL (p);
738 }
739 
740 /* Extract A's type.  */
741 
Lisp_Type(XTYPE)742 INLINE enum Lisp_Type
743 (XTYPE) (Lisp_Object a)
744 {
745 #if USE_LSB_TAG
746   return lisp_h_XTYPE (a);
747 #else
748   EMACS_UINT i = XLI (a);
749   return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
750 #endif
751 }
752 
753 /* True if A has type tag TAG.
754    Equivalent to XTYPE (a) == TAG, but often faster.  */
755 
756 INLINE bool
757 (TAGGEDP) (Lisp_Object a, enum Lisp_Type tag)
758 {
759   return lisp_h_TAGGEDP (a, tag);
760 }
761 
762 INLINE void
763 (CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x)
764 {
765   lisp_h_CHECK_TYPE (ok, predicate, x);
766 }
767 
768 /* Extract A's pointer value, assuming A's Lisp type is TYPE and the
769    extracted pointer's type is CTYPE *.  */
770 
771 #define XUNTAG(a, type, ctype) ((ctype *) \
772 				((char *) XLP (a) - LISP_WORD_TAG (type)))
773 
774 /* A forwarding pointer to a value.  It uses a generic pointer to
775    avoid alignment bugs that could occur if it used a pointer to a
776    union of the possible values (struct Lisp_Objfwd, struct
777    Lisp_Intfwd, etc.).  The pointer is packaged inside a struct to
778    help static checking.  */
779 typedef struct { void const *fwdptr; } lispfwd;
780 
781 /* Interned state of a symbol.  */
782 
783 enum symbol_interned
784 {
785   SYMBOL_UNINTERNED = 0,
786   SYMBOL_INTERNED = 1,
787   SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
788 };
789 
790 enum symbol_redirect
791 {
792   SYMBOL_PLAINVAL  = 4,
793   SYMBOL_VARALIAS  = 1,
794   SYMBOL_LOCALIZED = 2,
795   SYMBOL_FORWARDED = 3
796 };
797 
798 enum symbol_trapped_write
799 {
800   SYMBOL_UNTRAPPED_WRITE = 0,
801   SYMBOL_NOWRITE = 1,
802   SYMBOL_TRAPPED_WRITE = 2
803 };
804 
805 struct Lisp_Symbol
806 {
807   union
808   {
809     struct
810     {
811       bool_bf gcmarkbit : 1;
812 
813       /* Indicates where the value can be found:
814 	 0 : it's a plain var, the value is in the `value' field.
815 	 1 : it's a varalias, the value is really in the `alias' symbol.
816 	 2 : it's a localized var, the value is in the `blv' object.
817 	 3 : it's a forwarding variable, the value is in `forward'.  */
818       ENUM_BF (symbol_redirect) redirect : 3;
819 
820       /* 0 : normal case, just set the value
821 	 1 : constant, cannot set, e.g. nil, t, :keywords.
822 	 2 : trap the write, call watcher functions.  */
823       ENUM_BF (symbol_trapped_write) trapped_write : 2;
824 
825       /* Interned state of the symbol.  This is an enumerator from
826 	 enum symbol_interned.  */
827       unsigned interned : 2;
828 
829       /* True means that this variable has been explicitly declared
830 	 special (with `defvar' etc), and shouldn't be lexically bound.  */
831       bool_bf declared_special : 1;
832 
833       /* True if pointed to from purespace and hence can't be GC'd.  */
834       bool_bf pinned : 1;
835 
836       /* The symbol's name, as a Lisp string.  */
837       Lisp_Object name;
838 
839       /* Value of the symbol or Qunbound if unbound.  Which alternative of the
840 	 union is used depends on the `redirect' field above.  */
841       union {
842 	Lisp_Object value;
843 	struct Lisp_Symbol *alias;
844 	struct Lisp_Buffer_Local_Value *blv;
845 	lispfwd fwd;
846       } val;
847 
848       /* Function value of the symbol or Qnil if not fboundp.  */
849       Lisp_Object function;
850 
851       /* The symbol's property list.  */
852       Lisp_Object plist;
853 
854       /* Next symbol in obarray bucket, if the symbol is interned.  */
855       struct Lisp_Symbol *next;
856     } s;
857     GCALIGNED_UNION_MEMBER
858   } u;
859 };
860 verify (GCALIGNED (struct Lisp_Symbol));
861 
862 /* Declare a Lisp-callable function.  The MAXARGS parameter has the same
863    meaning as in the DEFUN macro, and is used to construct a prototype.  */
864 /* We can use the same trick as in the DEFUN macro to generate the
865    appropriate prototype.  */
866 #define EXFUN(fnname, maxargs) \
867   extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
868 
869 /* Note that the weird token-substitution semantics of ANSI C makes
870    this work for MANY and UNEVALLED.  */
871 #define DEFUN_ARGS_MANY		(ptrdiff_t, Lisp_Object *)
872 #define DEFUN_ARGS_UNEVALLED	(Lisp_Object)
873 #define DEFUN_ARGS_0	(void)
874 #define DEFUN_ARGS_1	(Lisp_Object)
875 #define DEFUN_ARGS_2	(Lisp_Object, Lisp_Object)
876 #define DEFUN_ARGS_3	(Lisp_Object, Lisp_Object, Lisp_Object)
877 #define DEFUN_ARGS_4	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
878 #define DEFUN_ARGS_5	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
879 			 Lisp_Object)
880 #define DEFUN_ARGS_6	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
881 			 Lisp_Object, Lisp_Object)
882 #define DEFUN_ARGS_7	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
883 			 Lisp_Object, Lisp_Object, Lisp_Object)
884 #define DEFUN_ARGS_8	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
885 			 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
886 
887 /* untagged_ptr represents a pointer before tagging, and Lisp_Word_tag
888    contains a possibly-shifted tag to be added to an untagged_ptr to
889    convert it to a Lisp_Word.  */
890 #if LISP_WORDS_ARE_POINTERS
891 /* untagged_ptr is a pointer so that the compiler knows that TAG_PTR
892    yields a pointer; this can help with gcc -fcheck-pointer-bounds.
893    It is char * so that adding a tag uses simple machine addition.  */
894 typedef char *untagged_ptr;
895 typedef uintptr_t Lisp_Word_tag;
896 #else
897 /* untagged_ptr is an unsigned integer instead of a pointer, so that
898    it can be added to the possibly-wider Lisp_Word_tag type without
899    losing information.  */
900 typedef uintptr_t untagged_ptr;
901 typedef EMACS_UINT Lisp_Word_tag;
902 #endif
903 
904 /* A integer value tagged with TAG, and otherwise all zero.  */
905 #define LISP_WORD_TAG(tag) \
906   ((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS))
907 
908 /* An initializer for a Lisp_Object that contains TAG along with PTR.  */
909 #define TAG_PTR(tag, ptr) \
910   LISP_INITIALLY ((Lisp_Word) ((untagged_ptr) (ptr) + LISP_WORD_TAG (tag)))
911 
912 /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
913    designed for use as an initializer, even for a constant initializer.  */
914 #define LISPSYM_INITIALLY(name) \
915   TAG_PTR (Lisp_Symbol, (char *) (intptr_t) ((i##name) * sizeof *lispsym))
916 
917 /* Declare extern constants for Lisp symbols.  These can be helpful
918    when using a debugger like GDB, on older platforms where the debug
919    format does not represent C macros.  However, they are unbounded
920    and would just be asking for trouble if checking pointer bounds.  */
921 #ifdef __CHKP__
922 # define DEFINE_LISP_SYMBOL(name)
923 #else
924 # define DEFINE_LISP_SYMBOL(name) \
925    DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
926    DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
927 #endif
928 
929 /* The index of the C-defined Lisp symbol SYM.
930    This can be used in a static initializer.  */
931 #define SYMBOL_INDEX(sym) i##sym
932 
933 /* By default, define macros for Qt, etc., as this leads to a bit
934    better performance in the core Emacs interpreter.  A plugin can
935    define DEFINE_NON_NIL_Q_SYMBOL_MACROS to be false, to be portable to
936    other Emacs instances that assign different values to Qt, etc.  */
937 #ifndef DEFINE_NON_NIL_Q_SYMBOL_MACROS
938 # define DEFINE_NON_NIL_Q_SYMBOL_MACROS true
939 #endif
940 
941 /* True if N is a power of 2.  N should be positive.  */
942 
943 #define POWER_OF_2(n) (((n) & ((n) - 1)) == 0)
944 
945 /* Return X rounded to the next multiple of Y.  Y should be positive,
946    and Y - 1 + X should not overflow.  Arguments should not have side
947    effects, as they are evaluated more than once.  Tune for Y being a
948    power of 2.  */
949 
950 #define ROUNDUP(x, y) (POWER_OF_2 (y)					\
951                        ? ((y) - 1 + (x)) & ~ ((y) - 1)			\
952                        : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y))
953 
954 #include "globals.h"
955 
956 /* Header of vector-like objects.  This documents the layout constraints on
957    vectors and pseudovectors (objects of PVEC_xxx subtype).  It also prevents
958    compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
959    and PSEUDOVECTORP cast their pointers to union vectorlike_header *,
960    because when two such pointers potentially alias, a compiler won't
961    incorrectly reorder loads and stores to their size fields.  See
962    Bug#8546.  This union formerly contained more members, and there's
963    no compelling reason to change it to a struct merely because the
964    number of members has been reduced to one.  */
965 union vectorlike_header
966   {
967     /* The main member contains various pieces of information:
968        - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
969        - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
970          vector (0) or a pseudovector (1).
971        - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
972          of slots) of the vector.
973        - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields:
974 	 - a) pseudovector subtype held in PVEC_TYPE_MASK field;
975 	 - b) number of Lisp_Objects slots at the beginning of the object
976 	   held in PSEUDOVECTOR_SIZE_MASK field.  These objects are always
977 	   traced by the GC;
978 	 - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and
979 	   measured in word_size units.  Rest fields may also include
980 	   Lisp_Objects, but these objects usually needs some special treatment
981 	   during GC.
982 	 There are some exceptions.  For PVEC_FREE, b) is always zero.  For
983 	 PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero.
984 	 Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
985 	 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots.  */
986     ptrdiff_t size;
987   };
988 
989 INLINE bool
990 (SYMBOLP) (Lisp_Object x)
991 {
992   return lisp_h_SYMBOLP (x);
993 }
994 
995 INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
XSYMBOL(Lisp_Object a)996 XSYMBOL (Lisp_Object a)
997 {
998   eassert (SYMBOLP (a));
999   intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
1000   void *p = (char *) lispsym + i;
1001 #ifdef __CHKP__
1002   /* Bypass pointer checking.  Although this could be improved it is
1003      probably not worth the trouble.  */
1004   p = __builtin___bnd_set_ptr_bounds (p, sizeof (struct Lisp_Symbol));
1005 #endif
1006   return p;
1007 }
1008 
1009 INLINE Lisp_Object
make_lisp_symbol(struct Lisp_Symbol * sym)1010 make_lisp_symbol (struct Lisp_Symbol *sym)
1011 {
1012 #ifdef __CHKP__
1013   /* Although '__builtin___bnd_narrow_ptr_bounds (sym, sym, sizeof *sym)'
1014      should be more efficient, it runs afoul of GCC bug 83251
1015      <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>.
1016      Also, attempting to call __builtin___bnd_chk_ptr_bounds (sym, sizeof *sym)
1017      here seems to trigger a GCC bug, as yet undiagnosed.  */
1018   char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym);
1019   char *symoffset = addr - (intptr_t) lispsym;
1020 #else
1021   /* If !__CHKP__, GCC 7 x86-64 generates faster code if lispsym is
1022      cast to char * rather than to intptr_t.  */
1023   char *symoffset = (char *) ((char *) sym - (char *) lispsym);
1024 #endif
1025   Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
1026   eassert (XSYMBOL (a) == sym);
1027   return a;
1028 }
1029 
1030 INLINE Lisp_Object
builtin_lisp_symbol(int index)1031 builtin_lisp_symbol (int index)
1032 {
1033   return make_lisp_symbol (&lispsym[index]);
1034 }
1035 
1036 INLINE bool
c_symbol_p(struct Lisp_Symbol * sym)1037 c_symbol_p (struct Lisp_Symbol *sym)
1038 {
1039   char *bp = (char *) lispsym;
1040   char *sp = (char *) sym;
1041   if (PTRDIFF_MAX < INTPTR_MAX)
1042     return bp <= sp && sp < bp + sizeof lispsym;
1043   else
1044     {
1045       ptrdiff_t offset = sp - bp;
1046       return 0 <= offset && offset < sizeof lispsym;
1047     }
1048 }
1049 
1050 INLINE void
1051 (CHECK_SYMBOL) (Lisp_Object x)
1052 {
1053   lisp_h_CHECK_SYMBOL (x);
1054 }
1055 
1056 /* In the size word of a vector, this bit means the vector has been marked.  */
1057 
1058 DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
1059 # define ARRAY_MARK_FLAG PTRDIFF_MIN
1060 DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
1061 
1062 /* In the size word of a struct Lisp_Vector, this bit means it's really
1063    some other vector-like object.  */
1064 DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
1065 # define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
1066 DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
1067 
1068 /* In a pseudovector, the size field actually contains a word with one
1069    PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
1070    with PVEC_TYPE_MASK to indicate the actual type.  */
1071 enum pvec_type
1072 {
1073   PVEC_NORMAL_VECTOR,
1074   PVEC_FREE,
1075   PVEC_BIGNUM,
1076   PVEC_MARKER,
1077   PVEC_OVERLAY,
1078   PVEC_FINALIZER,
1079   PVEC_MISC_PTR,
1080   PVEC_USER_PTR,
1081   PVEC_PROCESS,
1082   PVEC_FRAME,
1083   PVEC_WINDOW,
1084   PVEC_BOOL_VECTOR,
1085   PVEC_BUFFER,
1086   PVEC_HASH_TABLE,
1087   PVEC_TERMINAL,
1088   PVEC_WINDOW_CONFIGURATION,
1089   PVEC_SUBR,
1090   PVEC_OTHER,            /* Should never be visible to Elisp code.  */
1091   PVEC_XWIDGET,
1092   PVEC_XWIDGET_VIEW,
1093   PVEC_THREAD,
1094   PVEC_MUTEX,
1095   PVEC_CONDVAR,
1096   PVEC_MODULE_FUNCTION,
1097 
1098   /* These should be last, check internal_equal to see why.  */
1099   PVEC_COMPILED,
1100   PVEC_CHAR_TABLE,
1101   PVEC_SUB_CHAR_TABLE,
1102   PVEC_RECORD,
1103   PVEC_FONT /* Should be last because it's used for range checking.  */
1104 };
1105 
1106 enum More_Lisp_Bits
1107   {
1108     /* For convenience, we also store the number of elements in these bits.
1109        Note that this size is not necessarily the memory-footprint size, but
1110        only the number of Lisp_Object fields (that need to be traced by GC).
1111        The distinction is used, e.g., by Lisp_Process, which places extra
1112        non-Lisp_Object fields at the end of the structure.  */
1113     PSEUDOVECTOR_SIZE_BITS = 12,
1114     PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
1115 
1116     /* To calculate the memory footprint of the pseudovector, it's useful
1117        to store the size of non-Lisp area in word_size units here.  */
1118     PSEUDOVECTOR_REST_BITS = 12,
1119     PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
1120 			      << PSEUDOVECTOR_SIZE_BITS),
1121 
1122     /* Used to extract pseudovector subtype information.  */
1123     PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
1124     PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
1125   };
1126 
1127 /* These functions extract various sorts of values from a Lisp_Object.
1128    For example, if tem is a Lisp_Object whose type is Lisp_Cons,
1129    XCONS (tem) is the struct Lisp_Cons * pointing to the memory for
1130    that cons.  */
1131 
1132 /* Largest and smallest representable fixnum values.  These are the C
1133    values.  They are macros for use in #if and static initializers.  */
1134 #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
1135 #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
1136 
1137 /* True if the possibly-unsigned integer I doesn't fit in a fixnum.  */
1138 
1139 #define FIXNUM_OVERFLOW_P(i) \
1140   (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
1141 
1142 #if USE_LSB_TAG
1143 
Lisp_Object(make_fixnum)1144 INLINE Lisp_Object
1145 (make_fixnum) (EMACS_INT n)
1146 {
1147   eassert (!FIXNUM_OVERFLOW_P (n));
1148   return lisp_h_make_fixnum_wrap (n);
1149 }
1150 
EMACS_INT(XFIXNUM_RAW)1151 INLINE EMACS_INT
1152 (XFIXNUM_RAW) (Lisp_Object a)
1153 {
1154   return lisp_h_XFIXNUM_RAW (a);
1155 }
1156 
1157 INLINE Lisp_Object
make_ufixnum(EMACS_INT n)1158 make_ufixnum (EMACS_INT n)
1159 {
1160   eassert (0 <= n && n <= INTMASK);
1161   return lisp_h_make_fixnum_wrap (n);
1162 }
1163 
1164 #else /* ! USE_LSB_TAG */
1165 
1166 /* Although compiled only if ! USE_LSB_TAG, the following functions
1167    also work when USE_LSB_TAG; this is to aid future maintenance when
1168    the lisp_h_* macros are eventually removed.  */
1169 
1170 /* Make a fixnum representing the value of the low order bits of N.  */
1171 INLINE Lisp_Object
make_fixnum(EMACS_INT n)1172 make_fixnum (EMACS_INT n)
1173 {
1174   eassert (! FIXNUM_OVERFLOW_P (n));
1175   EMACS_INT int0 = Lisp_Int0;
1176   if (USE_LSB_TAG)
1177     {
1178       EMACS_UINT u = n;
1179       n = u << INTTYPEBITS;
1180       n += int0;
1181     }
1182   else
1183     {
1184       n &= INTMASK;
1185       n += (int0 << VALBITS);
1186     }
1187   return XIL (n);
1188 }
1189 
1190 /* Extract A's value as a signed integer.  Unlike XFIXNUM, this works
1191    on any Lisp object, although the resulting integer is useful only
1192    for things like hashing when A is not a fixnum.  */
1193 INLINE EMACS_INT
XFIXNUM_RAW(Lisp_Object a)1194 XFIXNUM_RAW (Lisp_Object a)
1195 {
1196   EMACS_INT i = XLI (a);
1197   if (! USE_LSB_TAG)
1198     {
1199       EMACS_UINT u = i;
1200       i = u << INTTYPEBITS;
1201     }
1202   return i >> INTTYPEBITS;
1203 }
1204 
1205 INLINE Lisp_Object
make_ufixnum(EMACS_INT n)1206 make_ufixnum (EMACS_INT n)
1207 {
1208   eassert (0 <= n && n <= INTMASK);
1209   EMACS_INT int0 = Lisp_Int0;
1210   if (USE_LSB_TAG)
1211     {
1212       EMACS_UINT u = n;
1213       n = u << INTTYPEBITS;
1214       n += int0;
1215     }
1216   else
1217     n += int0 << VALBITS;
1218   return XIL (n);
1219 }
1220 
1221 #endif /* ! USE_LSB_TAG */
1222 
1223 INLINE bool
1224 (FIXNUMP) (Lisp_Object x)
1225 {
1226   return lisp_h_FIXNUMP (x);
1227 }
1228 
1229 INLINE EMACS_INT
XFIXNUM(Lisp_Object a)1230 XFIXNUM (Lisp_Object a)
1231 {
1232   eassert (FIXNUMP (a));
1233   return XFIXNUM_RAW (a);
1234 }
1235 
1236 /* Extract A's value as an unsigned integer in the range 0..INTMASK.  */
1237 INLINE EMACS_UINT
XUFIXNUM_RAW(Lisp_Object a)1238 XUFIXNUM_RAW (Lisp_Object a)
1239 {
1240   EMACS_UINT i = XLI (a);
1241   return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
1242 }
1243 INLINE EMACS_UINT
XUFIXNUM(Lisp_Object a)1244 XUFIXNUM (Lisp_Object a)
1245 {
1246   eassert (FIXNUMP (a));
1247   return XUFIXNUM_RAW (a);
1248 }
1249 
1250 /* Return A's hash, which is in the range 0..INTMASK.  */
EMACS_INT(XHASH)1251 INLINE EMACS_INT
1252 (XHASH) (Lisp_Object a)
1253 {
1254   return lisp_h_XHASH (a);
1255 }
1256 
1257 /* Like make_fixnum (N), but may be faster.  N must be in nonnegative range.  */
1258 INLINE Lisp_Object
make_fixed_natnum(EMACS_INT n)1259 make_fixed_natnum (EMACS_INT n)
1260 {
1261   eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
1262   EMACS_INT int0 = Lisp_Int0;
1263   return USE_LSB_TAG ? make_fixnum (n) : XIL (n + (int0 << VALBITS));
1264 }
1265 
1266 /* Return true if X and Y are the same object.  */
1267 
1268 INLINE bool
1269 (EQ) (Lisp_Object x, Lisp_Object y)
1270 {
1271   return lisp_h_EQ (x, y);
1272 }
1273 
1274 INLINE intmax_t
clip_to_bounds(intmax_t lower,intmax_t num,intmax_t upper)1275 clip_to_bounds (intmax_t lower, intmax_t num, intmax_t upper)
1276 {
1277   return num < lower ? lower : num <= upper ? num : upper;
1278 }
1279 
1280 /* Construct a Lisp_Object from a value or address.  */
1281 
1282 INLINE Lisp_Object
make_lisp_ptr(void * ptr,enum Lisp_Type type)1283 make_lisp_ptr (void *ptr, enum Lisp_Type type)
1284 {
1285   Lisp_Object a = TAG_PTR (type, ptr);
1286   eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr);
1287   return a;
1288 }
1289 
1290 #define XSETINT(a, b) ((a) = make_fixnum (b))
1291 #define XSETFASTINT(a, b) ((a) = make_fixed_natnum (b))
1292 #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
1293 #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
1294 #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
1295 #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b))
1296 #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
1297 
1298 /* Return a Lisp_Object value that does not correspond to any object.
1299    This can make some Lisp objects on free lists recognizable in O(1).  */
1300 
1301 INLINE Lisp_Object
dead_object(void)1302 dead_object (void)
1303 {
1304   return make_lisp_ptr (NULL, Lisp_String);
1305 }
1306 
1307 /* Pseudovector types.  */
1308 
1309 #define XSETPVECTYPE(v, code)						\
1310   ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))
1311 #define PVECHEADERSIZE(code, lispsize, restsize) \
1312   (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS) \
1313    | ((restsize) << PSEUDOVECTOR_SIZE_BITS) | (lispsize))
1314 #define XSETPVECTYPESIZE(v, code, lispsize, restsize)		\
1315   ((v)->header.size = PVECHEADERSIZE (code, lispsize, restsize))
1316 
1317 /* The cast to union vectorlike_header * avoids aliasing issues.  */
1318 #define XSETPSEUDOVECTOR(a, b, code) \
1319   XSETTYPED_PSEUDOVECTOR (a, b,					\
1320 			  (XUNTAG (a, Lisp_Vectorlike,		\
1321 				   union vectorlike_header)	\
1322 			   ->size),				\
1323 			  code)
1324 #define XSETTYPED_PSEUDOVECTOR(a, b, size, code)			\
1325   (XSETVECTOR (a, b),							\
1326    eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))		\
1327 	    == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
1328 
1329 #define XSETWINDOW_CONFIGURATION(a, b) \
1330   (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
1331 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
1332 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
1333 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
1334 #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
1335 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
1336 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
1337 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
1338 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
1339 #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
1340 #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD))
1341 #define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX))
1342 #define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR))
1343 
1344 /* Efficiently convert a pointer to a Lisp object and back.  The
1345    pointer is represented as a fixnum, so the garbage collector
1346    does not know about it.  The pointer should not have both Lisp_Int1
1347    bits set, which makes this conversion inherently unportable.  */
1348 
1349 INLINE void *
XFIXNUMPTR(Lisp_Object a)1350 XFIXNUMPTR (Lisp_Object a)
1351 {
1352   return XUNTAG (a, Lisp_Int0, char);
1353 }
1354 
1355 INLINE Lisp_Object
make_pointer_integer_unsafe(void * p)1356 make_pointer_integer_unsafe (void *p)
1357 {
1358   Lisp_Object a = TAG_PTR (Lisp_Int0, p);
1359   return a;
1360 }
1361 
1362 INLINE Lisp_Object
make_pointer_integer(void * p)1363 make_pointer_integer (void *p)
1364 {
1365   Lisp_Object a = make_pointer_integer_unsafe (p);
1366   eassert (FIXNUMP (a) && XFIXNUMPTR (a) == p);
1367   return a;
1368 }
1369 
1370 /* See the macros in intervals.h.  */
1371 
1372 typedef struct interval *INTERVAL;
1373 
1374 struct Lisp_Cons
1375 {
1376   union
1377   {
1378     struct
1379     {
1380       /* Car of this cons cell.  */
1381       Lisp_Object car;
1382 
1383       union
1384       {
1385 	/* Cdr of this cons cell.  */
1386 	Lisp_Object cdr;
1387 
1388 	/* Used to chain conses on a free list.  */
1389 	struct Lisp_Cons *chain;
1390       } u;
1391     } s;
1392     GCALIGNED_UNION_MEMBER
1393   } u;
1394 };
1395 verify (GCALIGNED (struct Lisp_Cons));
1396 
1397 INLINE bool
1398 (NILP) (Lisp_Object x)
1399 {
1400   return lisp_h_NILP (x);
1401 }
1402 
1403 INLINE bool
1404 (CONSP) (Lisp_Object x)
1405 {
1406   return lisp_h_CONSP (x);
1407 }
1408 
1409 INLINE void
CHECK_CONS(Lisp_Object x)1410 CHECK_CONS (Lisp_Object x)
1411 {
1412   CHECK_TYPE (CONSP (x), Qconsp, x);
1413 }
1414 
1415 INLINE struct Lisp_Cons *
1416 (XCONS) (Lisp_Object a)
1417 {
1418   return lisp_h_XCONS (a);
1419 }
1420 
1421 /* Take the car or cdr of something known to be a cons cell.  */
1422 /* The _addr functions shouldn't be used outside of the minimal set
1423    of code that has to know what a cons cell looks like.  Other code not
1424    part of the basic lisp implementation should assume that the car and cdr
1425    fields are not accessible.  (What if we want to switch to
1426    a copying collector someday?  Cached cons cell field addresses may be
1427    invalidated at arbitrary points.)  */
1428 INLINE Lisp_Object *
xcar_addr(Lisp_Object c)1429 xcar_addr (Lisp_Object c)
1430 {
1431   return &XCONS (c)->u.s.car;
1432 }
1433 INLINE Lisp_Object *
xcdr_addr(Lisp_Object c)1434 xcdr_addr (Lisp_Object c)
1435 {
1436   return &XCONS (c)->u.s.u.cdr;
1437 }
1438 
1439 /* Use these from normal code.  */
1440 
Lisp_Object(XCAR)1441 INLINE Lisp_Object
1442 (XCAR) (Lisp_Object c)
1443 {
1444   return lisp_h_XCAR (c);
1445 }
1446 
Lisp_Object(XCDR)1447 INLINE Lisp_Object
1448 (XCDR) (Lisp_Object c)
1449 {
1450   return lisp_h_XCDR (c);
1451 }
1452 
1453 /* Use these to set the fields of a cons cell.
1454 
1455    Note that both arguments may refer to the same object, so 'n'
1456    should not be read after 'c' is first modified.  */
1457 INLINE void
XSETCAR(Lisp_Object c,Lisp_Object n)1458 XSETCAR (Lisp_Object c, Lisp_Object n)
1459 {
1460   *xcar_addr (c) = n;
1461 }
1462 INLINE void
XSETCDR(Lisp_Object c,Lisp_Object n)1463 XSETCDR (Lisp_Object c, Lisp_Object n)
1464 {
1465   *xcdr_addr (c) = n;
1466 }
1467 
1468 /* Take the car or cdr of something whose type is not known.  */
1469 INLINE Lisp_Object
CAR(Lisp_Object c)1470 CAR (Lisp_Object c)
1471 {
1472   if (CONSP (c))
1473     return XCAR (c);
1474   if (!NILP (c))
1475     wrong_type_argument (Qlistp, c);
1476   return Qnil;
1477 }
1478 INLINE Lisp_Object
CDR(Lisp_Object c)1479 CDR (Lisp_Object c)
1480 {
1481   if (CONSP (c))
1482     return XCDR (c);
1483   if (!NILP (c))
1484     wrong_type_argument (Qlistp, c);
1485   return Qnil;
1486 }
1487 
1488 /* Take the car or cdr of something whose type is not known.  */
1489 INLINE Lisp_Object
CAR_SAFE(Lisp_Object c)1490 CAR_SAFE (Lisp_Object c)
1491 {
1492   return CONSP (c) ? XCAR (c) : Qnil;
1493 }
1494 INLINE Lisp_Object
CDR_SAFE(Lisp_Object c)1495 CDR_SAFE (Lisp_Object c)
1496 {
1497   return CONSP (c) ? XCDR (c) : Qnil;
1498 }
1499 
1500 /* In a string or vector, the sign bit of u.s.size is the gc mark bit.  */
1501 
1502 struct Lisp_String
1503 {
1504   union
1505   {
1506     struct
1507     {
1508       ptrdiff_t size;
1509       ptrdiff_t size_byte;
1510       INTERVAL intervals;	/* Text properties in this string.  */
1511       unsigned char *data;
1512     } s;
1513     struct Lisp_String *next;
1514     GCALIGNED_UNION_MEMBER
1515   } u;
1516 };
1517 verify (GCALIGNED (struct Lisp_String));
1518 
1519 INLINE bool
STRINGP(Lisp_Object x)1520 STRINGP (Lisp_Object x)
1521 {
1522   return TAGGEDP (x, Lisp_String);
1523 }
1524 
1525 INLINE void
CHECK_STRING(Lisp_Object x)1526 CHECK_STRING (Lisp_Object x)
1527 {
1528   CHECK_TYPE (STRINGP (x), Qstringp, x);
1529 }
1530 
1531 INLINE struct Lisp_String *
XSTRING(Lisp_Object a)1532 XSTRING (Lisp_Object a)
1533 {
1534   eassert (STRINGP (a));
1535   return XUNTAG (a, Lisp_String, struct Lisp_String);
1536 }
1537 
1538 /* True if STR is a multibyte string.  */
1539 INLINE bool
STRING_MULTIBYTE(Lisp_Object str)1540 STRING_MULTIBYTE (Lisp_Object str)
1541 {
1542   return 0 <= XSTRING (str)->u.s.size_byte;
1543 }
1544 
1545 /* An upper bound on the number of bytes in a Lisp string, not
1546    counting the terminating NUL.  This a tight enough bound to
1547    prevent integer overflow errors that would otherwise occur during
1548    string size calculations.  A string cannot contain more bytes than
1549    a fixnum can represent, nor can it be so long that C pointer
1550    arithmetic stops working on the string plus its terminating NUL.
1551    Although the actual size limit (see STRING_BYTES_MAX in alloc.c)
1552    may be a bit smaller than STRING_BYTES_BOUND, calculating it here
1553    would expose alloc.c internal details that we'd rather keep
1554    private.
1555 
1556    This is a macro for use in static initializers.  The cast to
1557    ptrdiff_t ensures that the macro is signed.  */
1558 #define STRING_BYTES_BOUND  \
1559   ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
1560 
1561 /* Mark STR as a unibyte string.  */
1562 #define STRING_SET_UNIBYTE(STR)				\
1563   do {							\
1564     if (XSTRING (STR)->u.s.size == 0)			\
1565       (STR) = empty_unibyte_string;			\
1566     else						\
1567       XSTRING (STR)->u.s.size_byte = -1;		\
1568   } while (false)
1569 
1570 /* Mark STR as a multibyte string.  Assure that STR contains only
1571    ASCII characters in advance.  */
1572 #define STRING_SET_MULTIBYTE(STR)			\
1573   do {							\
1574     if (XSTRING (STR)->u.s.size == 0)			\
1575       (STR) = empty_multibyte_string;			\
1576     else						\
1577       XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \
1578   } while (false)
1579 
1580 /* Convenience functions for dealing with Lisp strings.  */
1581 
1582 INLINE unsigned char *
SDATA(Lisp_Object string)1583 SDATA (Lisp_Object string)
1584 {
1585   return XSTRING (string)->u.s.data;
1586 }
1587 INLINE char *
SSDATA(Lisp_Object string)1588 SSDATA (Lisp_Object string)
1589 {
1590   /* Avoid "differ in sign" warnings.  */
1591   return (char *) SDATA (string);
1592 }
1593 INLINE unsigned char
SREF(Lisp_Object string,ptrdiff_t index)1594 SREF (Lisp_Object string, ptrdiff_t index)
1595 {
1596   return SDATA (string)[index];
1597 }
1598 INLINE void
SSET(Lisp_Object string,ptrdiff_t index,unsigned char new)1599 SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
1600 {
1601   SDATA (string)[index] = new;
1602 }
1603 INLINE ptrdiff_t
SCHARS(Lisp_Object string)1604 SCHARS (Lisp_Object string)
1605 {
1606   ptrdiff_t nchars = XSTRING (string)->u.s.size;
1607   eassume (0 <= nchars);
1608   return nchars;
1609 }
1610 
1611 #ifdef GC_CHECK_STRING_BYTES
1612 extern ptrdiff_t string_bytes (struct Lisp_String *);
1613 #endif
1614 INLINE ptrdiff_t
STRING_BYTES(struct Lisp_String * s)1615 STRING_BYTES (struct Lisp_String *s)
1616 {
1617 #ifdef GC_CHECK_STRING_BYTES
1618   ptrdiff_t nbytes = string_bytes (s);
1619 #else
1620   ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte;
1621 #endif
1622   eassume (0 <= nbytes);
1623   return nbytes;
1624 }
1625 
1626 INLINE ptrdiff_t
SBYTES(Lisp_Object string)1627 SBYTES (Lisp_Object string)
1628 {
1629   return STRING_BYTES (XSTRING (string));
1630 }
1631 INLINE void
STRING_SET_CHARS(Lisp_Object string,ptrdiff_t newsize)1632 STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
1633 {
1634   /* This function cannot change the size of data allocated for the
1635      string when it was created.  */
1636   eassert (STRING_MULTIBYTE (string)
1637 	   ? 0 <= newsize && newsize <= SBYTES (string)
1638 	   : newsize == SCHARS (string));
1639   XSTRING (string)->u.s.size = newsize;
1640 }
1641 
1642 /* A regular vector is just a header plus an array of Lisp_Objects.  */
1643 
1644 struct Lisp_Vector
1645   {
1646     union vectorlike_header header;
1647     Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
1648   } GCALIGNED_STRUCT;
1649 
1650 INLINE bool
1651 (VECTORLIKEP) (Lisp_Object x)
1652 {
1653   return lisp_h_VECTORLIKEP (x);
1654 }
1655 
1656 INLINE struct Lisp_Vector *
XVECTOR(Lisp_Object a)1657 XVECTOR (Lisp_Object a)
1658 {
1659   eassert (VECTORLIKEP (a));
1660   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Vector);
1661 }
1662 
1663 INLINE ptrdiff_t
ASIZE(Lisp_Object array)1664 ASIZE (Lisp_Object array)
1665 {
1666   ptrdiff_t size = XVECTOR (array)->header.size;
1667   eassume (0 <= size);
1668   return size;
1669 }
1670 
1671 INLINE ptrdiff_t
PVSIZE(Lisp_Object pv)1672 PVSIZE (Lisp_Object pv)
1673 {
1674   return ASIZE (pv) & PSEUDOVECTOR_SIZE_MASK;
1675 }
1676 
1677 INLINE bool
VECTORP(Lisp_Object x)1678 VECTORP (Lisp_Object x)
1679 {
1680   return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG);
1681 }
1682 
1683 INLINE void
CHECK_VECTOR(Lisp_Object x)1684 CHECK_VECTOR (Lisp_Object x)
1685 {
1686   CHECK_TYPE (VECTORP (x), Qvectorp, x);
1687 }
1688 
1689 
1690 /* A pseudovector is like a vector, but has other non-Lisp components.  */
1691 
1692 INLINE enum pvec_type
PSEUDOVECTOR_TYPE(const struct Lisp_Vector * v)1693 PSEUDOVECTOR_TYPE (const struct Lisp_Vector *v)
1694 {
1695   ptrdiff_t size = v->header.size;
1696   return (size & PSEUDOVECTOR_FLAG
1697           ? (size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS
1698           : PVEC_NORMAL_VECTOR);
1699 }
1700 
1701 /* Can't be used with PVEC_NORMAL_VECTOR.  */
1702 INLINE bool
PSEUDOVECTOR_TYPEP(const union vectorlike_header * a,enum pvec_type code)1703 PSEUDOVECTOR_TYPEP (const union vectorlike_header *a, enum pvec_type code)
1704 {
1705   /* We don't use PSEUDOVECTOR_TYPE here so as to avoid a shift
1706    * operation when `code' is known.  */
1707   return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
1708 	  == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
1709 }
1710 
1711 /* True if A is a pseudovector whose code is CODE.  */
1712 INLINE bool
PSEUDOVECTORP(Lisp_Object a,int code)1713 PSEUDOVECTORP (Lisp_Object a, int code)
1714 {
1715   if (! VECTORLIKEP (a))
1716     return false;
1717   else
1718     {
1719       /* Converting to union vectorlike_header * avoids aliasing issues.  */
1720       return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike,
1721 					 union vectorlike_header),
1722 				 code);
1723     }
1724 }
1725 
1726 /* A boolvector is a kind of vectorlike, with contents like a string.  */
1727 
1728 struct Lisp_Bool_Vector
1729   {
1730     /* HEADER.SIZE is the vector's size field.  It doesn't have the real size,
1731        just the subtype information.  */
1732     union vectorlike_header header;
1733     /* This is the size in bits.  */
1734     EMACS_INT size;
1735     /* The actual bits, packed into bytes.
1736        Zeros fill out the last word if needed.
1737        The bits are in little-endian order in the bytes, and
1738        the bytes are in little-endian order in the words.  */
1739     bits_word data[FLEXIBLE_ARRAY_MEMBER];
1740   } GCALIGNED_STRUCT;
1741 
1742 /* Some handy constants for calculating sizes
1743    and offsets, mostly of vectorlike objects.
1744 
1745    The garbage collector assumes that the initial part of any struct
1746    that starts with a union vectorlike_header followed by N
1747    Lisp_Objects (some possibly in arrays and/or a trailing flexible
1748    array) will be laid out like a struct Lisp_Vector with N
1749    Lisp_Objects.  This assumption is true in practice on known Emacs
1750    targets even though the C standard does not guarantee it.  This
1751    header contains a few sanity checks that should suffice to detect
1752    violations of this assumption on plausible practical hosts.  */
1753 
1754 enum
1755   {
1756     header_size = offsetof (struct Lisp_Vector, contents),
1757     bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
1758     word_size = sizeof (Lisp_Object)
1759   };
1760 
1761 /* The number of data words and bytes in a bool vector with SIZE bits.  */
1762 
1763 INLINE EMACS_INT
bool_vector_words(EMACS_INT size)1764 bool_vector_words (EMACS_INT size)
1765 {
1766   eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
1767   return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD;
1768 }
1769 
1770 INLINE EMACS_INT
bool_vector_bytes(EMACS_INT size)1771 bool_vector_bytes (EMACS_INT size)
1772 {
1773   eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
1774   return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
1775 }
1776 
1777 INLINE bool
BOOL_VECTOR_P(Lisp_Object a)1778 BOOL_VECTOR_P (Lisp_Object a)
1779 {
1780   return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR);
1781 }
1782 
1783 INLINE void
CHECK_BOOL_VECTOR(Lisp_Object x)1784 CHECK_BOOL_VECTOR (Lisp_Object x)
1785 {
1786   CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x);
1787 }
1788 
1789 INLINE struct Lisp_Bool_Vector *
XBOOL_VECTOR(Lisp_Object a)1790 XBOOL_VECTOR (Lisp_Object a)
1791 {
1792   eassert (BOOL_VECTOR_P (a));
1793   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bool_Vector);
1794 }
1795 
1796 INLINE EMACS_INT
bool_vector_size(Lisp_Object a)1797 bool_vector_size (Lisp_Object a)
1798 {
1799   EMACS_INT size = XBOOL_VECTOR (a)->size;
1800   eassume (0 <= size);
1801   return size;
1802 }
1803 
1804 INLINE bits_word *
bool_vector_data(Lisp_Object a)1805 bool_vector_data (Lisp_Object a)
1806 {
1807   return XBOOL_VECTOR (a)->data;
1808 }
1809 
1810 INLINE unsigned char *
bool_vector_uchar_data(Lisp_Object a)1811 bool_vector_uchar_data (Lisp_Object a)
1812 {
1813   return (unsigned char *) bool_vector_data (a);
1814 }
1815 
1816 /* True if A's Ith bit is set.  */
1817 
1818 INLINE bool
bool_vector_bitref(Lisp_Object a,EMACS_INT i)1819 bool_vector_bitref (Lisp_Object a, EMACS_INT i)
1820 {
1821   eassume (0 <= i && i < bool_vector_size (a));
1822   return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
1823 	     & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
1824 }
1825 
1826 INLINE Lisp_Object
bool_vector_ref(Lisp_Object a,EMACS_INT i)1827 bool_vector_ref (Lisp_Object a, EMACS_INT i)
1828 {
1829   return bool_vector_bitref (a, i) ? Qt : Qnil;
1830 }
1831 
1832 /* Set A's Ith bit to B.  */
1833 
1834 INLINE void
bool_vector_set(Lisp_Object a,EMACS_INT i,bool b)1835 bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
1836 {
1837   unsigned char *addr;
1838 
1839   eassume (0 <= i && i < bool_vector_size (a));
1840   addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
1841 
1842   if (b)
1843     *addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
1844   else
1845     *addr &= ~ (1 << (i % BOOL_VECTOR_BITS_PER_CHAR));
1846 }
1847 
1848 /* Conveniences for dealing with Lisp arrays.  */
1849 
1850 INLINE Lisp_Object
AREF(Lisp_Object array,ptrdiff_t idx)1851 AREF (Lisp_Object array, ptrdiff_t idx)
1852 {
1853   return XVECTOR (array)->contents[idx];
1854 }
1855 
1856 INLINE Lisp_Object *
aref_addr(Lisp_Object array,ptrdiff_t idx)1857 aref_addr (Lisp_Object array, ptrdiff_t idx)
1858 {
1859   return & XVECTOR (array)->contents[idx];
1860 }
1861 
1862 INLINE ptrdiff_t
gc_asize(Lisp_Object array)1863 gc_asize (Lisp_Object array)
1864 {
1865   /* Like ASIZE, but also can be used in the garbage collector.  */
1866   return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
1867 }
1868 
1869 INLINE void
ASET(Lisp_Object array,ptrdiff_t idx,Lisp_Object val)1870 ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1871 {
1872   eassert (0 <= idx && idx < ASIZE (array));
1873   XVECTOR (array)->contents[idx] = val;
1874 }
1875 
1876 INLINE void
gc_aset(Lisp_Object array,ptrdiff_t idx,Lisp_Object val)1877 gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1878 {
1879   /* Like ASET, but also can be used in the garbage collector:
1880      sweep_weak_table calls set_hash_key etc. while the table is marked.  */
1881   eassert (0 <= idx && idx < gc_asize (array));
1882   XVECTOR (array)->contents[idx] = val;
1883 }
1884 
1885 /* True, since Qnil's representation is zero.  Every place in the code
1886    that assumes Qnil is zero should verify (NIL_IS_ZERO), to make it easy
1887    to find such assumptions later if we change Qnil to be nonzero.
1888    Test iQnil and Lisp_Symbol instead of Qnil directly, since the latter
1889    is not suitable for use in an integer constant expression.  */
1890 enum { NIL_IS_ZERO = iQnil == 0 && Lisp_Symbol == 0 };
1891 
1892 /* Clear the object addressed by P, with size NBYTES, so that all its
1893    bytes are zero and all its Lisp values are nil.  */
1894 INLINE void
memclear(void * p,ptrdiff_t nbytes)1895 memclear (void *p, ptrdiff_t nbytes)
1896 {
1897   eassert (0 <= nbytes);
1898   verify (NIL_IS_ZERO);
1899   /* Since Qnil is zero, memset suffices.  */
1900   memset (p, 0, nbytes);
1901 }
1902 
1903 /* If a struct is made to look like a vector, this macro returns the length
1904    of the shortest vector that would hold that struct.  */
1905 
1906 #define VECSIZE(type)						\
1907   ((sizeof (type) - header_size + word_size - 1) / word_size)
1908 
1909 /* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
1910    at the end and we need to compute the number of Lisp_Object fields (the
1911    ones that the GC needs to trace).  */
1912 
1913 #define PSEUDOVECSIZE(type, lastlispfield)				\
1914   (offsetof (type, lastlispfield) + word_size < header_size		\
1915    ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size)
1916 
1917 /* Compute A OP B, using the unsigned comparison operator OP.  A and B
1918    should be integer expressions.  This is not the same as
1919    mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
1920    returns true.  For efficiency, prefer plain unsigned comparison if A
1921    and B's sizes both fit (after integer promotion).  */
1922 #define UNSIGNED_CMP(a, op, b)						\
1923   (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned)	\
1924    ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0)			\
1925    : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
1926 
1927 /* True iff C is an ASCII character.  */
1928 #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
1929 
1930 /* A char-table is a kind of vectorlike, with contents like a vector,
1931    but with a few additional slots.  For some purposes, it makes sense
1932    to handle a char-table as type 'struct Lisp_Vector'.  An element of
1933    a char-table can be any Lisp object, but if it is a sub-char-table,
1934    we treat it as a table that contains information of a specific
1935    range of characters.  A sub-char-table is like a vector, but with
1936    two integer fields between the header and Lisp data, which means
1937    that it has to be marked with some precautions (see mark_char_table
1938    in alloc.c).  A sub-char-table appears only in an element of a
1939    char-table, and there's no way to access it directly from a Lisp
1940    program.  */
1941 
1942 enum CHARTAB_SIZE_BITS
1943   {
1944     CHARTAB_SIZE_BITS_0 = 6,
1945     CHARTAB_SIZE_BITS_1 = 4,
1946     CHARTAB_SIZE_BITS_2 = 5,
1947     CHARTAB_SIZE_BITS_3 = 7
1948   };
1949 
1950 extern const int chartab_size[4];
1951 
1952 struct Lisp_Char_Table
1953   {
1954     /* HEADER.SIZE is the vector's size field, which also holds the
1955        pseudovector type information.  It holds the size, too.
1956        The size counts the defalt, parent, purpose, ascii,
1957        contents, and extras slots.  */
1958     union vectorlike_header header;
1959 
1960     /* This holds the default value, which is used whenever the value
1961        for a specific character is nil.  */
1962     Lisp_Object defalt;
1963 
1964     /* This points to another char table, from which we inherit when the
1965        value for a specific character is nil.  The `defalt' slot takes
1966        precedence over this.  */
1967     Lisp_Object parent;
1968 
1969     /* This is a symbol which says what kind of use this char-table is
1970        meant for.  */
1971     Lisp_Object purpose;
1972 
1973     /* The bottom sub char-table for characters in the range 0..127.  It
1974        is nil if no ASCII character has a specific value.  */
1975     Lisp_Object ascii;
1976 
1977     Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
1978 
1979     /* These hold additional data.  It is a vector.  */
1980     Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER];
1981   } GCALIGNED_STRUCT;
1982 
1983 INLINE bool
CHAR_TABLE_P(Lisp_Object a)1984 CHAR_TABLE_P (Lisp_Object a)
1985 {
1986   return PSEUDOVECTORP (a, PVEC_CHAR_TABLE);
1987 }
1988 
1989 INLINE struct Lisp_Char_Table *
XCHAR_TABLE(Lisp_Object a)1990 XCHAR_TABLE (Lisp_Object a)
1991 {
1992   eassert (CHAR_TABLE_P (a));
1993   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Char_Table);
1994 }
1995 
1996 struct Lisp_Sub_Char_Table
1997   {
1998     /* HEADER.SIZE is the vector's size field, which also holds the
1999        pseudovector type information.  It holds the size, too.  */
2000     union vectorlike_header header;
2001 
2002     /* Depth of this sub char-table.  It should be 1, 2, or 3.  A sub
2003        char-table of depth 1 contains 16 elements, and each element
2004        covers 4096 (128*32) characters.  A sub char-table of depth 2
2005        contains 32 elements, and each element covers 128 characters.  A
2006        sub char-table of depth 3 contains 128 elements, and each element
2007        is for one character.  */
2008     int depth;
2009 
2010     /* Minimum character covered by the sub char-table.  */
2011     int min_char;
2012 
2013     /* Use set_sub_char_table_contents to set this.  */
2014     Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
2015   } GCALIGNED_STRUCT;
2016 
2017 INLINE bool
SUB_CHAR_TABLE_P(Lisp_Object a)2018 SUB_CHAR_TABLE_P (Lisp_Object a)
2019 {
2020   return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE);
2021 }
2022 
2023 INLINE struct Lisp_Sub_Char_Table *
XSUB_CHAR_TABLE(Lisp_Object a)2024 XSUB_CHAR_TABLE (Lisp_Object a)
2025 {
2026   eassert (SUB_CHAR_TABLE_P (a));
2027   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sub_Char_Table);
2028 }
2029 
2030 INLINE Lisp_Object
CHAR_TABLE_REF_ASCII(Lisp_Object ct,ptrdiff_t idx)2031 CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
2032 {
2033   struct Lisp_Char_Table *tbl = NULL;
2034   Lisp_Object val;
2035   do
2036     {
2037       tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct);
2038       val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii
2039 	     : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]);
2040       if (NILP (val))
2041 	val = tbl->defalt;
2042     }
2043   while (NILP (val) && ! NILP (tbl->parent));
2044 
2045   return val;
2046 }
2047 
2048 /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
2049    characters.  Does not check validity of CT.  */
2050 INLINE Lisp_Object
CHAR_TABLE_REF(Lisp_Object ct,int idx)2051 CHAR_TABLE_REF (Lisp_Object ct, int idx)
2052 {
2053   return (ASCII_CHAR_P (idx)
2054 	  ? CHAR_TABLE_REF_ASCII (ct, idx)
2055 	  : char_table_ref (ct, idx));
2056 }
2057 
2058 /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
2059    8-bit European characters.  Does not check validity of CT.  */
2060 INLINE void
CHAR_TABLE_SET(Lisp_Object ct,int idx,Lisp_Object val)2061 CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
2062 {
2063   if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii))
2064     set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val);
2065   else
2066     char_table_set (ct, idx, val);
2067 }
2068 
2069 /* This structure describes a built-in function.
2070    It is generated by the DEFUN macro only.
2071    defsubr makes it into a Lisp object.  */
2072 
2073 struct Lisp_Subr
2074   {
2075     union vectorlike_header header;
2076     union {
2077       Lisp_Object (*a0) (void);
2078       Lisp_Object (*a1) (Lisp_Object);
2079       Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
2080       Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object);
2081       Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2082       Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2083       Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2084       Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2085       Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2086       Lisp_Object (*aUNEVALLED) (Lisp_Object args);
2087       Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
2088     } function;
2089     short min_args, max_args;
2090     const char *symbol_name;
2091     const char *intspec;
2092     EMACS_INT doc;
2093   } GCALIGNED_STRUCT;
2094 union Aligned_Lisp_Subr
2095   {
2096     struct Lisp_Subr s;
2097     GCALIGNED_UNION_MEMBER
2098   };
2099 verify (GCALIGNED (union Aligned_Lisp_Subr));
2100 
2101 INLINE bool
SUBRP(Lisp_Object a)2102 SUBRP (Lisp_Object a)
2103 {
2104   return PSEUDOVECTORP (a, PVEC_SUBR);
2105 }
2106 
2107 INLINE struct Lisp_Subr *
XSUBR(Lisp_Object a)2108 XSUBR (Lisp_Object a)
2109 {
2110   eassert (SUBRP (a));
2111   return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s;
2112 }
2113 
2114 enum char_table_specials
2115   {
2116     /* This is the number of slots that every char table must have.  This
2117        counts the ordinary slots and the top, defalt, parent, and purpose
2118        slots.  */
2119     CHAR_TABLE_STANDARD_SLOTS
2120       = (PSEUDOVECSIZE (struct Lisp_Char_Table, contents) - 1
2121 	 + (1 << CHARTAB_SIZE_BITS_0)),
2122 
2123     /* This is the index of the first Lisp_Object field in Lisp_Sub_Char_Table
2124        when the latter is treated as an ordinary Lisp_Vector.  */
2125     SUB_CHAR_TABLE_OFFSET
2126       = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1
2127   };
2128 
2129 /* Sanity-check pseudovector layout.  */
2130 verify (offsetof (struct Lisp_Char_Table, defalt) == header_size);
2131 verify (offsetof (struct Lisp_Char_Table, extras)
2132 	== header_size + CHAR_TABLE_STANDARD_SLOTS * sizeof (Lisp_Object));
2133 verify (offsetof (struct Lisp_Sub_Char_Table, contents)
2134 	== header_size + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object));
2135 
2136 /* Return the number of "extra" slots in the char table CT.  */
2137 
2138 INLINE int
CHAR_TABLE_EXTRA_SLOTS(struct Lisp_Char_Table * ct)2139 CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
2140 {
2141   return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK)
2142 	  - CHAR_TABLE_STANDARD_SLOTS);
2143 }
2144 
2145 
2146 /* Save and restore the instruction and environment pointers,
2147    without affecting the signal mask.  */
2148 
2149 #ifdef HAVE__SETJMP
2150 typedef jmp_buf sys_jmp_buf;
2151 # define sys_setjmp(j) _setjmp (j)
2152 # define sys_longjmp(j, v) _longjmp (j, v)
2153 #elif defined HAVE_SIGSETJMP
2154 typedef sigjmp_buf sys_jmp_buf;
2155 # define sys_setjmp(j) sigsetjmp (j, 0)
2156 # define sys_longjmp(j, v) siglongjmp (j, v)
2157 #else
2158 /* A platform that uses neither _longjmp nor siglongjmp; assume
2159    longjmp does not affect the sigmask.  */
2160 typedef jmp_buf sys_jmp_buf;
2161 # define sys_setjmp(j) setjmp (j)
2162 # define sys_longjmp(j, v) longjmp (j, v)
2163 #endif
2164 
2165 #include "thread.h"
2166 
2167 /***********************************************************************
2168 			       Symbols
2169  ***********************************************************************/
2170 
2171 /* Value is name of symbol.  */
2172 
Lisp_Object(SYMBOL_VAL)2173 INLINE Lisp_Object
2174 (SYMBOL_VAL) (struct Lisp_Symbol *sym)
2175 {
2176   return lisp_h_SYMBOL_VAL (sym);
2177 }
2178 
2179 INLINE struct Lisp_Symbol *
SYMBOL_ALIAS(struct Lisp_Symbol * sym)2180 SYMBOL_ALIAS (struct Lisp_Symbol *sym)
2181 {
2182   eassume (sym->u.s.redirect == SYMBOL_VARALIAS && sym->u.s.val.alias);
2183   return sym->u.s.val.alias;
2184 }
2185 INLINE struct Lisp_Buffer_Local_Value *
SYMBOL_BLV(struct Lisp_Symbol * sym)2186 SYMBOL_BLV (struct Lisp_Symbol *sym)
2187 {
2188   eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && sym->u.s.val.blv);
2189   return sym->u.s.val.blv;
2190 }
2191 INLINE lispfwd
SYMBOL_FWD(struct Lisp_Symbol * sym)2192 SYMBOL_FWD (struct Lisp_Symbol *sym)
2193 {
2194   eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd.fwdptr);
2195   return sym->u.s.val.fwd;
2196 }
2197 
2198 INLINE void
2199 (SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v)
2200 {
2201   lisp_h_SET_SYMBOL_VAL (sym, v);
2202 }
2203 
2204 INLINE void
SET_SYMBOL_ALIAS(struct Lisp_Symbol * sym,struct Lisp_Symbol * v)2205 SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
2206 {
2207   eassume (sym->u.s.redirect == SYMBOL_VARALIAS && v);
2208   sym->u.s.val.alias = v;
2209 }
2210 INLINE void
SET_SYMBOL_BLV(struct Lisp_Symbol * sym,struct Lisp_Buffer_Local_Value * v)2211 SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
2212 {
2213   eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && v);
2214   sym->u.s.val.blv = v;
2215 }
2216 INLINE void
SET_SYMBOL_FWD(struct Lisp_Symbol * sym,void const * v)2217 SET_SYMBOL_FWD (struct Lisp_Symbol *sym, void const *v)
2218 {
2219   eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v);
2220   sym->u.s.val.fwd.fwdptr = v;
2221 }
2222 
2223 INLINE Lisp_Object
SYMBOL_NAME(Lisp_Object sym)2224 SYMBOL_NAME (Lisp_Object sym)
2225 {
2226   return XSYMBOL (sym)->u.s.name;
2227 }
2228 
2229 /* Value is true if SYM is an interned symbol.  */
2230 
2231 INLINE bool
SYMBOL_INTERNED_P(Lisp_Object sym)2232 SYMBOL_INTERNED_P (Lisp_Object sym)
2233 {
2234   return XSYMBOL (sym)->u.s.interned != SYMBOL_UNINTERNED;
2235 }
2236 
2237 /* Value is true if SYM is interned in initial_obarray.  */
2238 
2239 INLINE bool
SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(Lisp_Object sym)2240 SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
2241 {
2242   return XSYMBOL (sym)->u.s.interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
2243 }
2244 
2245 /* Value is non-zero if symbol cannot be changed through a simple set,
2246    i.e. it's a constant (e.g. nil, t, :keywords), or it has some
2247    watching functions.  */
2248 
2249 INLINE int
2250 (SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
2251 {
2252   return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
2253 }
2254 
2255 /* Value is non-zero if symbol cannot be changed at all, i.e. it's a
2256    constant (e.g. nil, t, :keywords).  Code that actually wants to
2257    write to SYM, should also check whether there are any watching
2258    functions.  */
2259 
2260 INLINE int
2261 (SYMBOL_CONSTANT_P) (Lisp_Object sym)
2262 {
2263   return lisp_h_SYMBOL_CONSTANT_P (sym);
2264 }
2265 
2266 /* Placeholder for make-docfile to process.  The actual symbol
2267    definition is done by lread.c's define_symbol.  */
2268 #define DEFSYM(sym, name) /* empty */
2269 
2270 
2271 /***********************************************************************
2272 			     Hash Tables
2273  ***********************************************************************/
2274 
2275 /* The structure of a Lisp hash table.  */
2276 
2277 struct Lisp_Hash_Table;
2278 
2279 struct hash_table_test
2280 {
2281   /* Name of the function used to compare keys.  */
2282   Lisp_Object name;
2283 
2284   /* User-supplied hash function, or nil.  */
2285   Lisp_Object user_hash_function;
2286 
2287   /* User-supplied key comparison function, or nil.  */
2288   Lisp_Object user_cmp_function;
2289 
2290   /* C function to compare two keys.  */
2291   Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *);
2292 
2293   /* C function to compute hash code.  */
2294   Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *);
2295 };
2296 
2297 struct Lisp_Hash_Table
2298 {
2299   /* Change pdumper.c if you change the fields here.
2300 
2301      IMPORTANT!!!!!!!
2302 
2303      Call hash_rehash_if_needed() before accessing.  */
2304 
2305   /* This is for Lisp; the hash table code does not refer to it.  */
2306   union vectorlike_header header;
2307 
2308   /* Nil if table is non-weak.  Otherwise a symbol describing the
2309      weakness of the table.  */
2310   Lisp_Object weak;
2311 
2312   /* Vector of hash codes, or nil if the table needs rehashing.
2313      If the I-th entry is unused, then hash[I] should be nil.  */
2314   Lisp_Object hash;
2315 
2316   /* Vector used to chain entries.  If entry I is free, next[I] is the
2317      entry number of the next free item.  If entry I is non-free,
2318      next[I] is the index of the next entry in the collision chain,
2319      or -1 if there is such entry.  */
2320   Lisp_Object next;
2321 
2322   /* Bucket vector.  An entry of -1 indicates no item is present,
2323      and a nonnegative entry is the index of the first item in
2324      a collision chain.  This vector's size can be larger than the
2325      hash table size to reduce collisions.  */
2326   Lisp_Object index;
2327 
2328   /* Only the fields above are traced normally by the GC.  The ones after
2329      'index' are special and are either ignored by the GC or traced in
2330      a special way (e.g. because of weakness).  */
2331 
2332   /* Number of key/value entries in the table.  */
2333   ptrdiff_t count;
2334 
2335   /* Index of first free entry in free list, or -1 if none.  */
2336   ptrdiff_t next_free;
2337 
2338   /* True if the table can be purecopied.  The table cannot be
2339      changed afterwards.  */
2340   bool purecopy;
2341 
2342   /* True if the table is mutable.  Ordinarily tables are mutable, but
2343      pure tables are not, and while a table is being mutated it is
2344      immutable for recursive attempts to mutate it.  */
2345   bool mutable;
2346 
2347   /* Resize hash table when number of entries / table size is >= this
2348      ratio.  */
2349   float rehash_threshold;
2350 
2351   /* Used when the table is resized.  If equal to a negative integer,
2352      the user rehash-size is the integer -REHASH_SIZE, and the new
2353      size is the old size plus -REHASH_SIZE.  If positive, the user
2354      rehash-size is the floating-point value REHASH_SIZE + 1, and the
2355      new size is the old size times REHASH_SIZE + 1.  */
2356   float rehash_size;
2357 
2358   /* Vector of keys and values.  The key of item I is found at index
2359      2 * I, the value is found at index 2 * I + 1.
2360      If the key is equal to Qunbound, then this slot is unused.
2361      This is gc_marked specially if the table is weak.  */
2362   Lisp_Object key_and_value;
2363 
2364   /* The comparison and hash functions.  */
2365   struct hash_table_test test;
2366 
2367   /* Next weak hash table if this is a weak hash table.  The head of
2368      the list is in weak_hash_tables.  Used only during garbage
2369      collection --- at other times, it is NULL.  */
2370   struct Lisp_Hash_Table *next_weak;
2371 } GCALIGNED_STRUCT;
2372 
2373 /* Sanity-check pseudovector layout.  */
2374 verify (offsetof (struct Lisp_Hash_Table, weak) == header_size);
2375 
2376 INLINE bool
HASH_TABLE_P(Lisp_Object a)2377 HASH_TABLE_P (Lisp_Object a)
2378 {
2379   return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
2380 }
2381 
2382 INLINE struct Lisp_Hash_Table *
XHASH_TABLE(Lisp_Object a)2383 XHASH_TABLE (Lisp_Object a)
2384 {
2385   eassert (HASH_TABLE_P (a));
2386   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table);
2387 }
2388 
2389 #define XSET_HASH_TABLE(VAR, PTR) \
2390      (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
2391 
2392 /* Value is the key part of entry IDX in hash table H.  */
2393 INLINE Lisp_Object
HASH_KEY(const struct Lisp_Hash_Table * h,ptrdiff_t idx)2394 HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
2395 {
2396   return AREF (h->key_and_value, 2 * idx);
2397 }
2398 
2399 /* Value is the value part of entry IDX in hash table H.  */
2400 INLINE Lisp_Object
HASH_VALUE(const struct Lisp_Hash_Table * h,ptrdiff_t idx)2401 HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
2402 {
2403   return AREF (h->key_and_value, 2 * idx + 1);
2404 }
2405 
2406 /* Value is the hash code computed for entry IDX in hash table H.  */
2407 INLINE Lisp_Object
HASH_HASH(const struct Lisp_Hash_Table * h,ptrdiff_t idx)2408 HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
2409 {
2410   return AREF (h->hash, idx);
2411 }
2412 
2413 /* Value is the size of hash table H.  */
2414 INLINE ptrdiff_t
HASH_TABLE_SIZE(const struct Lisp_Hash_Table * h)2415 HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
2416 {
2417   ptrdiff_t size = ASIZE (h->next);
2418   eassume (0 < size);
2419   return size;
2420 }
2421 
2422 void hash_table_rehash (struct Lisp_Hash_Table *h);
2423 
2424 INLINE bool
hash_rehash_needed_p(const struct Lisp_Hash_Table * h)2425 hash_rehash_needed_p (const struct Lisp_Hash_Table *h)
2426 {
2427   return NILP (h->hash);
2428 }
2429 
2430 INLINE void
hash_rehash_if_needed(struct Lisp_Hash_Table * h)2431 hash_rehash_if_needed (struct Lisp_Hash_Table *h)
2432 {
2433   if (hash_rehash_needed_p (h))
2434     hash_table_rehash (h);
2435 }
2436 
2437 /* Default size for hash tables if not specified.  */
2438 
2439 enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
2440 
2441 /* Default threshold specifying when to resize a hash table.  The
2442    value gives the ratio of current entries in the hash table and the
2443    size of the hash table.  */
2444 
2445 static float const DEFAULT_REHASH_THRESHOLD = 0.8125;
2446 
2447 /* Default factor by which to increase the size of a hash table, minus 1.  */
2448 
2449 static float const DEFAULT_REHASH_SIZE = 1.5 - 1;
2450 
2451 /* Combine two integers X and Y for hashing.  The result might exceed
2452    INTMASK.  */
2453 
2454 INLINE EMACS_UINT
sxhash_combine(EMACS_UINT x,EMACS_UINT y)2455 sxhash_combine (EMACS_UINT x, EMACS_UINT y)
2456 {
2457   return (x << 4) + (x >> (EMACS_INT_WIDTH - 4)) + y;
2458 }
2459 
2460 /* Hash X, returning a value in the range 0..INTMASK.  */
2461 
2462 INLINE EMACS_UINT
SXHASH_REDUCE(EMACS_UINT x)2463 SXHASH_REDUCE (EMACS_UINT x)
2464 {
2465   return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK;
2466 }
2467 
2468 struct Lisp_Marker
2469 {
2470   union vectorlike_header header;
2471 
2472   /* This is the buffer that the marker points into, or 0 if it points nowhere.
2473      Note: a chain of markers can contain markers pointing into different
2474      buffers (the chain is per buffer_text rather than per buffer, so it's
2475      shared between indirect buffers).  */
2476   /* This is used for (other than NULL-checking):
2477      - Fmarker_buffer
2478      - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
2479      - unchain_marker: to find the list from which to unchain.
2480      - Fkill_buffer: to only unchain the markers of current indirect buffer.
2481      */
2482   struct buffer *buffer;
2483 
2484   /* This flag is temporarily used in the functions
2485      decode/encode_coding_object to record that the marker position
2486      must be adjusted after the conversion.  */
2487   bool_bf need_adjustment : 1;
2488   /* True means normal insertion at the marker's position
2489      leaves the marker after the inserted text.  */
2490   bool_bf insertion_type : 1;
2491 
2492   /* The remaining fields are meaningless in a marker that
2493      does not point anywhere.  */
2494 
2495   /* For markers that point somewhere,
2496      this is used to chain of all the markers in a given buffer.
2497      The chain does not preserve markers from garbage collection;
2498      instead, markers are removed from the chain when freed by GC.  */
2499   /* We could remove it and use an array in buffer_text instead.
2500      That would also allow us to preserve it ordered.  */
2501   struct Lisp_Marker *next;
2502   /* This is the char position where the marker points.  */
2503   ptrdiff_t charpos;
2504   /* This is the byte position.
2505      It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
2506      used to implement the functionality of markers, but rather to (ab)use
2507      markers as a cache for char<->byte mappings).  */
2508   ptrdiff_t bytepos;
2509 } GCALIGNED_STRUCT;
2510 
2511 /* START and END are markers in the overlay's buffer, and
2512    PLIST is the overlay's property list.  */
2513 struct Lisp_Overlay
2514 /* An overlay's real data content is:
2515    - plist
2516    - buffer (really there are two buffer pointers, one per marker,
2517      and both points to the same buffer)
2518    - insertion type of both ends (per-marker fields)
2519    - start & start byte (of start marker)
2520    - end & end byte (of end marker)
2521    - next (singly linked list of overlays)
2522    - next fields of start and end markers (singly linked list of markers).
2523    I.e. 9words plus 2 bits, 3words of which are for external linked lists.
2524 */
2525   {
2526     union vectorlike_header header;
2527     Lisp_Object start;
2528     Lisp_Object end;
2529     Lisp_Object plist;
2530     struct Lisp_Overlay *next;
2531   } GCALIGNED_STRUCT;
2532 
2533 struct Lisp_Misc_Ptr
2534   {
2535     union vectorlike_header header;
2536     void *pointer;
2537   } GCALIGNED_STRUCT;
2538 
2539 extern Lisp_Object make_misc_ptr (void *);
2540 
2541 /* A mint_ptr object OBJ represents a C-language pointer P efficiently.
2542    Preferably (and typically), OBJ is a fixnum I such that
2543    XFIXNUMPTR (I) == P, as this represents P within a single Lisp value
2544    without requiring any auxiliary memory.  However, if P would be
2545    damaged by being tagged as an integer and then untagged via
2546    XFIXNUMPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P.
2547 
2548    mint_ptr objects are efficiency hacks intended for C code.
2549    Although xmint_ptr can be given any mint_ptr generated by non-buggy
2550    C code, it should not be given a mint_ptr generated from Lisp code
2551    as that would allow Lisp code to coin pointers from integers and
2552    could lead to crashes.  To package a C pointer into a Lisp-visible
2553    object you can put the pointer into a pseudovector instead; see
2554    Lisp_User_Ptr for an example.  */
2555 
2556 INLINE Lisp_Object
make_mint_ptr(void * a)2557 make_mint_ptr (void *a)
2558 {
2559   Lisp_Object val = TAG_PTR (Lisp_Int0, a);
2560   return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a);
2561 }
2562 
2563 INLINE bool
mint_ptrp(Lisp_Object x)2564 mint_ptrp (Lisp_Object x)
2565 {
2566   return FIXNUMP (x) || PSEUDOVECTORP (x, PVEC_MISC_PTR);
2567 }
2568 
2569 INLINE void *
xmint_pointer(Lisp_Object a)2570 xmint_pointer (Lisp_Object a)
2571 {
2572   eassert (mint_ptrp (a));
2573   if (FIXNUMP (a))
2574     return XFIXNUMPTR (a);
2575   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer;
2576 }
2577 
2578 struct Lisp_User_Ptr
2579 {
2580   union vectorlike_header header;
2581   void (*finalizer) (void *);
2582   void *p;
2583 } GCALIGNED_STRUCT;
2584 
2585 /* A finalizer sentinel.  */
2586 struct Lisp_Finalizer
2587   {
2588     union vectorlike_header header;
2589 
2590     /* Call FUNCTION when the finalizer becomes unreachable, even if
2591        FUNCTION contains a reference to the finalizer; i.e., call
2592        FUNCTION when it is reachable _only_ through finalizers.  */
2593     Lisp_Object function;
2594 
2595     /* Circular list of all active weak references.  */
2596     struct Lisp_Finalizer *prev;
2597     struct Lisp_Finalizer *next;
2598   } GCALIGNED_STRUCT;
2599 
2600 extern struct Lisp_Finalizer finalizers;
2601 extern struct Lisp_Finalizer doomed_finalizers;
2602 
2603 INLINE bool
FINALIZERP(Lisp_Object x)2604 FINALIZERP (Lisp_Object x)
2605 {
2606   return PSEUDOVECTORP (x, PVEC_FINALIZER);
2607 }
2608 
2609 INLINE struct Lisp_Finalizer *
XFINALIZER(Lisp_Object a)2610 XFINALIZER (Lisp_Object a)
2611 {
2612   eassert (FINALIZERP (a));
2613   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Finalizer);
2614 }
2615 
2616 INLINE bool
MARKERP(Lisp_Object x)2617 MARKERP (Lisp_Object x)
2618 {
2619   return PSEUDOVECTORP (x, PVEC_MARKER);
2620 }
2621 
2622 INLINE struct Lisp_Marker *
XMARKER(Lisp_Object a)2623 XMARKER (Lisp_Object a)
2624 {
2625   eassert (MARKERP (a));
2626   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Marker);
2627 }
2628 
2629 INLINE bool
OVERLAYP(Lisp_Object x)2630 OVERLAYP (Lisp_Object x)
2631 {
2632   return PSEUDOVECTORP (x, PVEC_OVERLAY);
2633 }
2634 
2635 INLINE struct Lisp_Overlay *
XOVERLAY(Lisp_Object a)2636 XOVERLAY (Lisp_Object a)
2637 {
2638   eassert (OVERLAYP (a));
2639   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay);
2640 }
2641 
2642 INLINE bool
USER_PTRP(Lisp_Object x)2643 USER_PTRP (Lisp_Object x)
2644 {
2645   return PSEUDOVECTORP (x, PVEC_USER_PTR);
2646 }
2647 
2648 INLINE struct Lisp_User_Ptr *
XUSER_PTR(Lisp_Object a)2649 XUSER_PTR (Lisp_Object a)
2650 {
2651   eassert (USER_PTRP (a));
2652   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr);
2653 }
2654 
2655 INLINE bool
BIGNUMP(Lisp_Object x)2656 BIGNUMP (Lisp_Object x)
2657 {
2658   return PSEUDOVECTORP (x, PVEC_BIGNUM);
2659 }
2660 
2661 INLINE bool
INTEGERP(Lisp_Object x)2662 INTEGERP (Lisp_Object x)
2663 {
2664   return FIXNUMP (x) || BIGNUMP (x);
2665 }
2666 
2667 /* Return a Lisp integer with value taken from N.  */
2668 INLINE Lisp_Object
make_int(intmax_t n)2669 make_int (intmax_t n)
2670 {
2671   return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n);
2672 }
2673 INLINE Lisp_Object
make_uint(uintmax_t n)2674 make_uint (uintmax_t n)
2675 {
2676   return FIXNUM_OVERFLOW_P (n) ? make_biguint (n) : make_fixnum (n);
2677 }
2678 
2679 /* Return a Lisp integer equal to the value of the C integer EXPR.  */
2680 #define INT_TO_INTEGER(expr) \
2681   (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
2682 
2683 
2684 /* Forwarding pointer to an int variable.
2685    This is allowed only in the value cell of a symbol,
2686    and it means that the symbol's value really lives in the
2687    specified int variable.  */
2688 struct Lisp_Intfwd
2689   {
2690     enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Int */
2691     intmax_t *intvar;
2692   };
2693 
2694 /* Boolean forwarding pointer to an int variable.
2695    This is like Lisp_Intfwd except that the ostensible
2696    "value" of the symbol is t if the bool variable is true,
2697    nil if it is false.  */
2698 struct Lisp_Boolfwd
2699   {
2700     enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Bool */
2701     bool *boolvar;
2702   };
2703 
2704 /* Forwarding pointer to a Lisp_Object variable.
2705    This is allowed only in the value cell of a symbol,
2706    and it means that the symbol's value really lives in the
2707    specified variable.  */
2708 struct Lisp_Objfwd
2709   {
2710     enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Obj */
2711     Lisp_Object *objvar;
2712   };
2713 
2714 /* Like Lisp_Objfwd except that value lives in a slot in the
2715    current buffer.  Value is byte index of slot within buffer.  */
2716 struct Lisp_Buffer_Objfwd
2717   {
2718     enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Buffer_Obj */
2719     int offset;
2720     /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
2721     Lisp_Object predicate;
2722   };
2723 
2724 /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
2725    the symbol has buffer-local bindings.  (Exception:
2726    some buffer-local variables are built-in, with their values stored
2727    in the buffer structure itself.  They are handled differently,
2728    using struct Lisp_Buffer_Objfwd.)
2729 
2730    The `valcell' slot holds the variable's current value (unless `fwd'
2731    is set).  This value is the one that corresponds to the loaded binding.
2732    To read or set the variable, you must first make sure the right binding
2733    is loaded; then you can access the value in (or through) `valcell'.
2734 
2735    `where' is the buffer for which the loaded binding was found.
2736    If it has changed, to make sure the right binding is loaded it is
2737    necessary to find which binding goes with the current buffer, then
2738    load it.  To load it, first unload the previous binding.
2739 
2740    `local_if_set' indicates that merely setting the variable creates a
2741    local binding for the current buffer.  Otherwise the latter, setting
2742    the variable does not do that; only make-local-variable does that.  */
2743 
2744 struct Lisp_Buffer_Local_Value
2745   {
2746     /* True means that merely setting the variable creates a local
2747        binding for the current buffer.  */
2748     bool_bf local_if_set : 1;
2749     /* True means that the binding now loaded was found.
2750        Presumably equivalent to (defcell!=valcell).  */
2751     bool_bf found : 1;
2752     /* If non-NULL, a forwarding to the C var where it should also be set.  */
2753     lispfwd fwd;	/* Should never be (Buffer|Kboard)_Objfwd.  */
2754     /* The buffer for which the loaded binding was found.  */
2755     Lisp_Object where;
2756     /* A cons cell that holds the default value.  It has the form
2757        (SYMBOL . DEFAULT-VALUE).  */
2758     Lisp_Object defcell;
2759     /* The cons cell from `where's parameter alist.
2760        It always has the form (SYMBOL . VALUE)
2761        Note that if `fwd' is non-NULL, VALUE may be out of date.
2762        Also if the currently loaded binding is the default binding, then
2763        this is `eq'ual to defcell.  */
2764     Lisp_Object valcell;
2765   };
2766 
2767 /* Like Lisp_Objfwd except that value lives in a slot in the
2768    current kboard.  */
2769 struct Lisp_Kboard_Objfwd
2770   {
2771     enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Kboard_Obj */
2772     int offset;
2773   };
2774 
2775 INLINE enum Lisp_Fwd_Type
XFWDTYPE(lispfwd a)2776 XFWDTYPE (lispfwd a)
2777 {
2778   enum Lisp_Fwd_Type const *p = a.fwdptr;
2779   return *p;
2780 }
2781 
2782 INLINE bool
BUFFER_OBJFWDP(lispfwd a)2783 BUFFER_OBJFWDP (lispfwd a)
2784 {
2785   return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
2786 }
2787 
2788 INLINE struct Lisp_Buffer_Objfwd const *
XBUFFER_OBJFWD(lispfwd a)2789 XBUFFER_OBJFWD (lispfwd a)
2790 {
2791   eassert (BUFFER_OBJFWDP (a));
2792   return a.fwdptr;
2793 }
2794 
2795 /* Lisp floating point type.  */
2796 struct Lisp_Float
2797   {
2798     union
2799     {
2800       double data;
2801       struct Lisp_Float *chain;
2802     } u;
2803   } GCALIGNED_STRUCT;
2804 
2805 INLINE bool
2806 (FLOATP) (Lisp_Object x)
2807 {
2808   return lisp_h_FLOATP (x);
2809 }
2810 
2811 INLINE struct Lisp_Float *
XFLOAT(Lisp_Object a)2812 XFLOAT (Lisp_Object a)
2813 {
2814   eassert (FLOATP (a));
2815   return XUNTAG (a, Lisp_Float, struct Lisp_Float);
2816 }
2817 
2818 INLINE double
XFLOAT_DATA(Lisp_Object f)2819 XFLOAT_DATA (Lisp_Object f)
2820 {
2821   return XFLOAT (f)->u.data;
2822 }
2823 
2824 /* Most hosts nowadays use IEEE floating point, so they use IEC 60559
2825    representations, have infinities and NaNs, and do not trap on
2826    exceptions.  Define IEEE_FLOATING_POINT to 1 if this host is one of the
2827    typical ones.  The C11 macro __STDC_IEC_559__ is close to what is
2828    wanted here, but is not quite right because Emacs does not require
2829    all the features of C11 Annex F (and does not require C11 at all,
2830    for that matter).  */
2831 
2832 #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
2833 			     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
2834 
2835 /* Meanings of slots in a Lisp_Compiled:  */
2836 
2837 enum Lisp_Compiled
2838   {
2839     COMPILED_ARGLIST = 0,
2840     COMPILED_BYTECODE = 1,
2841     COMPILED_CONSTANTS = 2,
2842     COMPILED_STACK_DEPTH = 3,
2843     COMPILED_DOC_STRING = 4,
2844     COMPILED_INTERACTIVE = 5
2845   };
2846 
2847 /* Flag bits in a character.  These also get used in termhooks.h.
2848    Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
2849    (MUlti-Lingual Emacs) might need 22 bits for the character value
2850    itself, so we probably shouldn't use any bits lower than 0x0400000.  */
2851 enum char_bits
2852   {
2853     CHAR_ALT = 0x0400000,
2854     CHAR_SUPER = 0x0800000,
2855     CHAR_HYPER = 0x1000000,
2856     CHAR_SHIFT = 0x2000000,
2857     CHAR_CTL = 0x4000000,
2858     CHAR_META = 0x8000000,
2859 
2860     CHAR_MODIFIER_MASK =
2861       CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META,
2862 
2863     /* Actually, the current Emacs uses 22 bits for the character value
2864        itself.  */
2865     CHARACTERBITS = 22
2866   };
2867 
2868 /* Data type checking.  */
2869 
2870 INLINE bool
FIXNATP(Lisp_Object x)2871 FIXNATP (Lisp_Object x)
2872 {
2873   return FIXNUMP (x) && 0 <= XFIXNUM (x);
2874 }
2875 
2876 /* Like XFIXNUM (A), but may be faster.  A must be nonnegative.  */
2877 INLINE EMACS_INT
XFIXNAT(Lisp_Object a)2878 XFIXNAT (Lisp_Object a)
2879 {
2880   eassert (FIXNUMP (a));
2881   EMACS_INT int0 = Lisp_Int0;
2882   EMACS_INT result = USE_LSB_TAG ? XFIXNUM (a) : XLI (a) - (int0 << VALBITS);
2883   eassume (0 <= result);
2884   return result;
2885 }
2886 
2887 INLINE bool
NUMBERP(Lisp_Object x)2888 NUMBERP (Lisp_Object x)
2889 {
2890   return INTEGERP (x) || FLOATP (x);
2891 }
2892 
2893 INLINE bool
RANGED_FIXNUMP(intmax_t lo,Lisp_Object x,intmax_t hi)2894 RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi)
2895 {
2896   return FIXNUMP (x) && lo <= XFIXNUM (x) && XFIXNUM (x) <= hi;
2897 }
2898 
2899 #define TYPE_RANGED_FIXNUMP(type, x) \
2900   (FIXNUMP (x)			      \
2901    && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XFIXNUM (x) : 0 <= XFIXNUM (x)) \
2902    && XFIXNUM (x) <= TYPE_MAXIMUM (type))
2903 
2904 INLINE bool
AUTOLOADP(Lisp_Object x)2905 AUTOLOADP (Lisp_Object x)
2906 {
2907   return CONSP (x) && EQ (Qautoload, XCAR (x));
2908 }
2909 
2910 
2911 /* Test for specific pseudovector types.  */
2912 
2913 INLINE bool
WINDOW_CONFIGURATIONP(Lisp_Object a)2914 WINDOW_CONFIGURATIONP (Lisp_Object a)
2915 {
2916   return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION);
2917 }
2918 
2919 INLINE bool
COMPILEDP(Lisp_Object a)2920 COMPILEDP (Lisp_Object a)
2921 {
2922   return PSEUDOVECTORP (a, PVEC_COMPILED);
2923 }
2924 
2925 INLINE bool
FRAMEP(Lisp_Object a)2926 FRAMEP (Lisp_Object a)
2927 {
2928   return PSEUDOVECTORP (a, PVEC_FRAME);
2929 }
2930 
2931 INLINE bool
RECORDP(Lisp_Object a)2932 RECORDP (Lisp_Object a)
2933 {
2934   return PSEUDOVECTORP (a, PVEC_RECORD);
2935 }
2936 
2937 INLINE void
CHECK_RECORD(Lisp_Object x)2938 CHECK_RECORD (Lisp_Object x)
2939 {
2940   CHECK_TYPE (RECORDP (x), Qrecordp, x);
2941 }
2942 
2943 /* Test for image (image . spec)  */
2944 INLINE bool
IMAGEP(Lisp_Object x)2945 IMAGEP (Lisp_Object x)
2946 {
2947   return CONSP (x) && EQ (XCAR (x), Qimage);
2948 }
2949 
2950 /* Array types.  */
2951 INLINE bool
ARRAYP(Lisp_Object x)2952 ARRAYP (Lisp_Object x)
2953 {
2954   return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x);
2955 }
2956 
2957 INLINE void
CHECK_LIST(Lisp_Object x)2958 CHECK_LIST (Lisp_Object x)
2959 {
2960   CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x);
2961 }
2962 
2963 INLINE void
CHECK_LIST_END(Lisp_Object x,Lisp_Object y)2964 CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
2965 {
2966   CHECK_TYPE (NILP (x), Qlistp, y);
2967 }
2968 
2969 INLINE void
2970 (CHECK_FIXNUM) (Lisp_Object x)
2971 {
2972   lisp_h_CHECK_FIXNUM (x);
2973 }
2974 
2975 INLINE void
CHECK_STRING_CAR(Lisp_Object x)2976 CHECK_STRING_CAR (Lisp_Object x)
2977 {
2978   CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
2979 }
2980 /* This is a bit special because we always need size afterwards.  */
2981 INLINE ptrdiff_t
CHECK_VECTOR_OR_STRING(Lisp_Object x)2982 CHECK_VECTOR_OR_STRING (Lisp_Object x)
2983 {
2984   if (VECTORP (x))
2985     return ASIZE (x);
2986   if (STRINGP (x))
2987     return SCHARS (x);
2988   wrong_type_argument (Qarrayp, x);
2989 }
2990 INLINE void
CHECK_ARRAY(Lisp_Object x,Lisp_Object predicate)2991 CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate)
2992 {
2993   CHECK_TYPE (ARRAYP (x), predicate, x);
2994 }
2995 INLINE void
CHECK_FIXNAT(Lisp_Object x)2996 CHECK_FIXNAT (Lisp_Object x)
2997 {
2998   CHECK_TYPE (FIXNATP (x), Qwholenump, x);
2999 }
3000 
3001 #define CHECK_RANGED_INTEGER(x, lo, hi)					\
3002   do {									\
3003     CHECK_FIXNUM (x);							\
3004     if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi)))			\
3005       args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); \
3006   } while (false)
3007 #define CHECK_TYPE_RANGED_INTEGER(type, x) \
3008   do {									\
3009     if (TYPE_SIGNED (type))						\
3010       CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
3011     else								\
3012       CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type));			\
3013   } while (false)
3014 
3015 #define CHECK_FIXNUM_COERCE_MARKER(x)					\
3016   do {									\
3017     if (MARKERP ((x)))							\
3018       XSETFASTINT (x, marker_position (x));				\
3019     else								\
3020       CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x);		\
3021   } while (false)
3022 
3023 INLINE double
XFLOATINT(Lisp_Object n)3024 XFLOATINT (Lisp_Object n)
3025 {
3026   return (FIXNUMP (n) ? XFIXNUM (n)
3027 	  : FLOATP (n) ? XFLOAT_DATA (n)
3028 	  : bignum_to_double (n));
3029 }
3030 
3031 INLINE void
CHECK_NUMBER(Lisp_Object x)3032 CHECK_NUMBER (Lisp_Object x)
3033 {
3034   CHECK_TYPE (NUMBERP (x), Qnumberp, x);
3035 }
3036 
3037 INLINE void
CHECK_INTEGER(Lisp_Object x)3038 CHECK_INTEGER (Lisp_Object x)
3039 {
3040   CHECK_TYPE (INTEGERP (x), Qnumberp, x);
3041 }
3042 
3043 #define CHECK_NUMBER_COERCE_MARKER(x)					\
3044   do {									\
3045     if (MARKERP (x))							\
3046       XSETFASTINT (x, marker_position (x));				\
3047     else								\
3048       CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);			\
3049   } while (false)
3050 
3051 #define CHECK_INTEGER_COERCE_MARKER(x)					\
3052   do {									\
3053     if (MARKERP (x))							\
3054       XSETFASTINT (x, marker_position (x));				\
3055     else								\
3056       CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x);		\
3057   } while (false)
3058 
3059 
3060 /* If we're not dumping using the legacy dumper and we might be using
3061    the portable dumper, try to bunch all the subr structures together
3062    for more efficient dump loading.  */
3063 #ifndef HAVE_UNEXEC
3064 # ifdef DARWIN_OS
3065 #  define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION ("__DATA,subrs")
3066 # else
3067 #  define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION (".subrs")
3068 # endif
3069 #else
3070 # define SUBR_SECTION_ATTRIBUTE
3071 #endif
3072 
3073 /* Define a built-in function for calling from Lisp.
3074  `lname' should be the name to give the function in Lisp,
3075     as a NUL-terminated C string.
3076  `fnname' should be the name of the function in C.
3077     By convention, it starts with F.
3078  `sname' should be the name for the C constant structure
3079     that records information on this function for internal use.
3080     By convention, it should be the same as `fnname' but with S instead of F.
3081     It's too bad that C macros can't compute this from `fnname'.
3082  `minargs' should be a number, the minimum number of arguments allowed.
3083  `maxargs' should be a number, the maximum number of arguments allowed,
3084     or else MANY or UNEVALLED.
3085     MANY means pass a vector of evaluated arguments,
3086 	 in the form of an integer number-of-arguments
3087 	 followed by the address of a vector of Lisp_Objects
3088 	 which contains the argument values.
3089     UNEVALLED means pass the list of unevaluated arguments
3090  `intspec' says how interactive arguments are to be fetched.
3091     If the string starts with a `(', `intspec' is evaluated and the resulting
3092     list is the list of arguments.
3093     If it's a string that doesn't start with `(', the value should follow
3094     the one of the doc string for `interactive'.
3095     A null string means call interactively with no arguments.
3096  `doc' is documentation for the user.  */
3097 
3098 /* This version of DEFUN declares a function prototype with the right
3099    arguments, so we can catch errors with maxargs at compile-time.  */
3100 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)	\
3101   SUBR_SECTION_ATTRIBUTE                                                \
3102   static union Aligned_Lisp_Subr sname =                                \
3103      {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },				\
3104        { .a ## maxargs = fnname },					\
3105        minargs, maxargs, lname, intspec, 0}};				\
3106    Lisp_Object fnname
3107 
3108 /* defsubr (Sname);
3109    is how we define the symbol for function `name' at start-up time.  */
3110 extern void defsubr (union Aligned_Lisp_Subr *);
3111 
3112 enum maxargs
3113   {
3114     MANY = -2,
3115     UNEVALLED = -1
3116   };
3117 
3118 /* Call a function F that accepts many args, passing it ARRAY's elements.  */
3119 #define CALLMANY(f, array) (f) (ARRAYELTS (array), array)
3120 
3121 /* Call a function F that accepts many args, passing it the remaining args,
3122    E.g., 'return CALLN (Fformat, fmt, text);' is less error-prone than
3123    '{ Lisp_Object a[2]; a[0] = fmt; a[1] = text; return Fformat (2, a); }'.
3124    CALLN requires at least one function argument (as C99 prohibits
3125    empty initializers), and is overkill for simple usages like
3126    'Finsert (1, &text);'.  */
3127 #define CALLN(f, ...) CALLMANY (f, ((Lisp_Object []) {__VA_ARGS__}))
3128 
3129 extern void defvar_lisp (struct Lisp_Objfwd const *, char const *);
3130 extern void defvar_lisp_nopro (struct Lisp_Objfwd const *, char const *);
3131 extern void defvar_bool (struct Lisp_Boolfwd const *, char const *);
3132 extern void defvar_int (struct Lisp_Intfwd const *, char const *);
3133 extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *);
3134 
3135 /* Macros we use to define forwarded Lisp variables.
3136    These are used in the syms_of_FILENAME functions.
3137 
3138    An ordinary (not in buffer_defaults, per-buffer, or per-keyboard)
3139    lisp variable is actually a field in `struct emacs_globals'.  The
3140    field's name begins with "f_", which is a convention enforced by
3141    these macros.  Each such global has a corresponding #define in
3142    globals.h; the plain name should be used in the code.
3143 
3144    E.g., the global "cons_cells_consed" is declared as "int
3145    f_cons_cells_consed" in globals.h, but there is a define:
3146 
3147       #define cons_cells_consed globals.f_cons_cells_consed
3148 
3149    All C code uses the `cons_cells_consed' name.  This is all done
3150    this way to support indirection for multi-threaded Emacs.  */
3151 
3152 #define DEFVAR_LISP(lname, vname, doc)		\
3153   do {						\
3154     static struct Lisp_Objfwd const o_fwd	\
3155       = {Lisp_Fwd_Obj, &globals.f_##vname};	\
3156     defvar_lisp (&o_fwd, lname);		\
3157   } while (false)
3158 #define DEFVAR_LISP_NOPRO(lname, vname, doc)	\
3159   do {						\
3160     static struct Lisp_Objfwd const o_fwd	\
3161       = {Lisp_Fwd_Obj, &globals.f_##vname};	\
3162     defvar_lisp_nopro (&o_fwd, lname);		\
3163   } while (false)
3164 #define DEFVAR_BOOL(lname, vname, doc)		\
3165   do {						\
3166     static struct Lisp_Boolfwd const b_fwd	\
3167       = {Lisp_Fwd_Bool, &globals.f_##vname};	\
3168     defvar_bool (&b_fwd, lname);		\
3169   } while (false)
3170 #define DEFVAR_INT(lname, vname, doc)		\
3171   do {						\
3172     static struct Lisp_Intfwd const i_fwd	\
3173       = {Lisp_Fwd_Int, &globals.f_##vname};	\
3174     defvar_int (&i_fwd, lname);			\
3175   } while (false)
3176 
3177 #define DEFVAR_KBOARD(lname, vname, doc)			\
3178   do {								\
3179     static struct Lisp_Kboard_Objfwd const ko_fwd		\
3180       = {Lisp_Fwd_Kboard_Obj, offsetof (KBOARD, vname##_)};	\
3181     defvar_kboard (&ko_fwd, lname);				\
3182   } while (false)
3183 
3184 
3185 /* Elisp uses multiple stacks:
3186    - The C stack.
3187    - The specpdl stack keeps track of backtraces, unwind-protects and
3188      dynamic let-bindings.  It is allocated from the 'specpdl' array,
3189      a manually managed stack.
3190    - The handler stack keeps track of active catch tags and condition-case
3191      handlers.  It is allocated in a manually managed stack implemented by a
3192      doubly-linked list allocated via xmalloc and never freed.  */
3193 
3194 /* Structure for recording Lisp call stack for backtrace purposes.  */
3195 
3196 /* The special binding stack holds the outer values of variables while
3197    they are bound by a function application or a let form, stores the
3198    code to be executed for unwind-protect forms.
3199 
3200    NOTE: The specbinding union is defined here, because SPECPDL_INDEX is
3201    used all over the place, needs to be fast, and needs to know the size of
3202    union specbinding.  But only eval.c should access it.  */
3203 
3204 enum specbind_tag {
3205   SPECPDL_UNWIND,		/* An unwind_protect function on Lisp_Object.  */
3206   SPECPDL_UNWIND_ARRAY,		/* Likewise, on an array that needs freeing.
3207 				   Its elements are potential Lisp_Objects.  */
3208   SPECPDL_UNWIND_PTR,		/* Likewise, on void *.  */
3209   SPECPDL_UNWIND_INT,		/* Likewise, on int.  */
3210   SPECPDL_UNWIND_INTMAX,	/* Likewise, on intmax_t.  */
3211   SPECPDL_UNWIND_EXCURSION,	/* Likewise, on an execursion.  */
3212   SPECPDL_UNWIND_VOID,		/* Likewise, with no arg.  */
3213   SPECPDL_BACKTRACE,		/* An element of the backtrace.  */
3214   SPECPDL_LET,			/* A plain and simple dynamic let-binding.  */
3215   /* Tags greater than SPECPDL_LET must be "subkinds" of LET.  */
3216   SPECPDL_LET_LOCAL,		/* A buffer-local let-binding.  */
3217   SPECPDL_LET_DEFAULT		/* A global binding for a localized var.  */
3218 };
3219 
3220 union specbinding
3221   {
3222     /* Aligning similar members consistently might help efficiency slightly
3223        (Bug#31996#25).  */
3224     ENUM_BF (specbind_tag) kind : CHAR_BIT;
3225     struct {
3226       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3227       void (*func) (Lisp_Object);
3228       Lisp_Object arg;
3229       EMACS_INT eval_depth;
3230     } unwind;
3231     struct {
3232       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3233       ptrdiff_t nelts;
3234       Lisp_Object *array;
3235     } unwind_array;
3236     struct {
3237       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3238       void (*func) (void *);
3239       void *arg;
3240     } unwind_ptr;
3241     struct {
3242       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3243       void (*func) (int);
3244       int arg;
3245     } unwind_int;
3246     struct {
3247       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3248       void (*func) (intmax_t);
3249       intmax_t arg;
3250     } unwind_intmax;
3251     struct {
3252       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3253       Lisp_Object marker, window;
3254     } unwind_excursion;
3255     struct {
3256       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3257       void (*func) (void);
3258     } unwind_void;
3259     struct {
3260       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3261       /* `where' is not used in the case of SPECPDL_LET.  */
3262       Lisp_Object symbol, old_value, where;
3263       /* Normally this is unused; but it is set to the symbol's
3264 	 current value when a thread is swapped out.  */
3265       Lisp_Object saved_value;
3266     } let;
3267     struct {
3268       ENUM_BF (specbind_tag) kind : CHAR_BIT;
3269       bool_bf debug_on_exit : 1;
3270       Lisp_Object function;
3271       Lisp_Object *args;
3272       ptrdiff_t nargs;
3273     } bt;
3274   };
3275 
3276 INLINE ptrdiff_t
SPECPDL_INDEX(void)3277 SPECPDL_INDEX (void)
3278 {
3279   return specpdl_ptr - specpdl;
3280 }
3281 
3282 /* This structure helps implement the `catch/throw' and `condition-case/signal'
3283    control structures.  A struct handler contains all the information needed to
3284    restore the state of the interpreter after a non-local jump.
3285 
3286    Handler structures are chained together in a doubly linked list; the `next'
3287    member points to the next outer catchtag and the `nextfree' member points in
3288    the other direction to the next inner element (which is typically the next
3289    free element since we mostly use it on the deepest handler).
3290 
3291    A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
3292    member is TAG, and then unbinds to it.  The `val' member is used to
3293    hold VAL while the stack is unwound; `val' is returned as the value
3294    of the catch form.  If there is a handler of type CATCHER_ALL, it will
3295    be treated as a handler for all invocations of `signal' and `throw';
3296    in this case `val' will be set to (ERROR-SYMBOL . DATA) or (TAG . VAL),
3297    respectively.  During stack unwinding, `nonlocal_exit' is set to
3298    specify the type of nonlocal exit that caused the stack unwinding.
3299 
3300    All the other members are concerned with restoring the interpreter
3301    state.
3302 
3303    Members are volatile if their values need to survive _longjmp when
3304    a 'struct handler' is a local variable.  */
3305 
3306 enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
3307 
3308 enum nonlocal_exit
3309 {
3310   NONLOCAL_EXIT_SIGNAL,
3311   NONLOCAL_EXIT_THROW,
3312 };
3313 
3314 struct handler
3315 {
3316   enum handlertype type;
3317   Lisp_Object tag_or_ch;
3318 
3319   /* The next two are set by unwind_to_catch.  */
3320   enum nonlocal_exit nonlocal_exit;
3321   Lisp_Object val;
3322 
3323   struct handler *next;
3324   struct handler *nextfree;
3325 
3326   /* The bytecode interpreter can have several handlers active at the same
3327      time, so when we longjmp to one of them, it needs to know which handler
3328      this was and what was the corresponding internal state.  This is stored
3329      here, and when we longjmp we make sure that handlerlist points to the
3330      proper handler.  */
3331   Lisp_Object *bytecode_top;
3332   int bytecode_dest;
3333 
3334   /* Most global vars are reset to their value via the specpdl mechanism,
3335      but a few others are handled by storing their value here.  */
3336   sys_jmp_buf jmp;
3337   EMACS_INT f_lisp_eval_depth;
3338   ptrdiff_t pdlcount;
3339   int poll_suppress_count;
3340   int interrupt_input_blocked;
3341 };
3342 
3343 extern Lisp_Object memory_signal_data;
3344 
3345 extern void maybe_quit (void);
3346 
3347 /* True if ought to quit now.  */
3348 
3349 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3350 
3351 /* Process a quit rarely, based on a counter COUNT, for efficiency.
3352    "Rarely" means once per USHRT_MAX + 1 times; this is somewhat
3353    arbitrary, but efficient.  */
3354 
3355 INLINE void
rarely_quit(unsigned short int count)3356 rarely_quit (unsigned short int count)
3357 {
3358   if (! count)
3359     maybe_quit ();
3360 }
3361 
3362 extern Lisp_Object Vascii_downcase_table;
3363 extern Lisp_Object Vascii_canon_table;
3364 
3365 /* Call staticpro (&var) to protect static variable `var'.  */
3366 
3367 void staticpro (Lisp_Object const *);
3368 
3369 enum { NSTATICS = 2048 };
3370 extern Lisp_Object const *staticvec[NSTATICS];
3371 extern int staticidx;
3372 
3373 
3374 /* Forward declarations for prototypes.  */
3375 struct window;
3376 struct frame;
3377 
3378 /* Define if the windowing system provides a menu bar.  */
3379 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
3380   || defined (HAVE_NS) || defined (USE_GTK)
3381 #define HAVE_EXT_MENU_BAR true
3382 #endif
3383 
3384 /* Define if the windowing system provides a tool-bar.  */
3385 #if defined (USE_GTK) || defined (HAVE_NS)
3386 #define HAVE_EXT_TOOL_BAR true
3387 #endif
3388 
3389 /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET.  */
3390 
3391 INLINE void
vcopy(Lisp_Object v,ptrdiff_t offset,Lisp_Object const * args,ptrdiff_t count)3392 vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args,
3393        ptrdiff_t count)
3394 {
3395   eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
3396   memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
3397 }
3398 
3399 /* Functions to modify hash tables.  */
3400 
3401 INLINE void
set_hash_key_slot(struct Lisp_Hash_Table * h,ptrdiff_t idx,Lisp_Object val)3402 set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3403 {
3404   gc_aset (h->key_and_value, 2 * idx, val);
3405 }
3406 
3407 INLINE void
set_hash_value_slot(struct Lisp_Hash_Table * h,ptrdiff_t idx,Lisp_Object val)3408 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3409 {
3410   gc_aset (h->key_and_value, 2 * idx + 1, val);
3411 }
3412 
3413 /* Use these functions to set Lisp_Object
3414    or pointer slots of struct Lisp_Symbol.  */
3415 
3416 INLINE void
set_symbol_function(Lisp_Object sym,Lisp_Object function)3417 set_symbol_function (Lisp_Object sym, Lisp_Object function)
3418 {
3419   XSYMBOL (sym)->u.s.function = function;
3420 }
3421 
3422 INLINE void
set_symbol_plist(Lisp_Object sym,Lisp_Object plist)3423 set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
3424 {
3425   XSYMBOL (sym)->u.s.plist = plist;
3426 }
3427 
3428 INLINE void
set_symbol_next(Lisp_Object sym,struct Lisp_Symbol * next)3429 set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
3430 {
3431   XSYMBOL (sym)->u.s.next = next;
3432 }
3433 
3434 INLINE void
make_symbol_constant(Lisp_Object sym)3435 make_symbol_constant (Lisp_Object sym)
3436 {
3437   XSYMBOL (sym)->u.s.trapped_write = SYMBOL_NOWRITE;
3438 }
3439 
3440 /* Buffer-local variable access functions.  */
3441 
3442 INLINE int
blv_found(struct Lisp_Buffer_Local_Value * blv)3443 blv_found (struct Lisp_Buffer_Local_Value *blv)
3444 {
3445   eassert (blv->found == !EQ (blv->defcell, blv->valcell));
3446   return blv->found;
3447 }
3448 
3449 /* Set overlay's property list.  */
3450 
3451 INLINE void
set_overlay_plist(Lisp_Object overlay,Lisp_Object plist)3452 set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
3453 {
3454   XOVERLAY (overlay)->plist = plist;
3455 }
3456 
3457 /* Get text properties of S.  */
3458 
3459 INLINE INTERVAL
string_intervals(Lisp_Object s)3460 string_intervals (Lisp_Object s)
3461 {
3462   return XSTRING (s)->u.s.intervals;
3463 }
3464 
3465 /* Set text properties of S to I.  */
3466 
3467 INLINE void
set_string_intervals(Lisp_Object s,INTERVAL i)3468 set_string_intervals (Lisp_Object s, INTERVAL i)
3469 {
3470   XSTRING (s)->u.s.intervals = i;
3471 }
3472 
3473 /* Set a Lisp slot in TABLE to VAL.  Most code should use this instead
3474    of setting slots directly.  */
3475 
3476 INLINE void
set_char_table_defalt(Lisp_Object table,Lisp_Object val)3477 set_char_table_defalt (Lisp_Object table, Lisp_Object val)
3478 {
3479   XCHAR_TABLE (table)->defalt = val;
3480 }
3481 INLINE void
set_char_table_purpose(Lisp_Object table,Lisp_Object val)3482 set_char_table_purpose (Lisp_Object table, Lisp_Object val)
3483 {
3484   XCHAR_TABLE (table)->purpose = val;
3485 }
3486 
3487 /* Set different slots in (sub)character tables.  */
3488 
3489 INLINE void
set_char_table_extras(Lisp_Object table,ptrdiff_t idx,Lisp_Object val)3490 set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3491 {
3492   eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
3493   XCHAR_TABLE (table)->extras[idx] = val;
3494 }
3495 
3496 INLINE void
set_char_table_contents(Lisp_Object table,ptrdiff_t idx,Lisp_Object val)3497 set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3498 {
3499   eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
3500   XCHAR_TABLE (table)->contents[idx] = val;
3501 }
3502 
3503 INLINE void
set_sub_char_table_contents(Lisp_Object table,ptrdiff_t idx,Lisp_Object val)3504 set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3505 {
3506   XSUB_CHAR_TABLE (table)->contents[idx] = val;
3507 }
3508 
3509 /* Defined in bignum.c.  This part of bignum.c's API does not require
3510    the caller to access bignum internals; see bignum.h for that.  */
3511 extern intmax_t bignum_to_intmax (Lisp_Object);
3512 extern uintmax_t bignum_to_uintmax (Lisp_Object);
3513 extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
3514 extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
3515 extern Lisp_Object bignum_to_string (Lisp_Object, int);
3516 extern Lisp_Object make_bignum_str (char const *, int);
3517 extern Lisp_Object make_neg_biguint (uintmax_t);
3518 extern Lisp_Object double_to_integer (double);
3519 
3520 /* Convert the integer NUM to *N.  Return true if successful, false
3521    (possibly setting *N) otherwise.  */
3522 INLINE bool
integer_to_intmax(Lisp_Object num,intmax_t * n)3523 integer_to_intmax (Lisp_Object num, intmax_t *n)
3524 {
3525   if (FIXNUMP (num))
3526     {
3527       *n = XFIXNUM (num);
3528       return true;
3529     }
3530   else
3531     {
3532       intmax_t i = bignum_to_intmax (num);
3533       *n = i;
3534       return i != 0;
3535     }
3536 }
3537 INLINE bool
integer_to_uintmax(Lisp_Object num,uintmax_t * n)3538 integer_to_uintmax (Lisp_Object num, uintmax_t *n)
3539 {
3540   if (FIXNUMP (num))
3541     {
3542       *n = XFIXNUM (num);
3543       return 0 <= XFIXNUM (num);
3544     }
3545   else
3546     {
3547       uintmax_t i = bignum_to_uintmax (num);
3548       *n = i;
3549       return i != 0;
3550     }
3551 }
3552 
3553 /* A modification count.  These are wide enough, and incremented
3554    rarely enough, so that they should never overflow a 60-bit counter
3555    in practice, and the code below assumes this so a compiler can
3556    generate better code if EMACS_INT is 64 bits.  */
3557 typedef intmax_t modiff_count;
3558 
3559 INLINE modiff_count
modiff_incr(modiff_count * a)3560 modiff_incr (modiff_count *a)
3561 {
3562   modiff_count a0 = *a;
3563   bool modiff_overflow = INT_ADD_WRAPV (a0, 1, a);
3564   eassert (!modiff_overflow && *a >> 30 >> 30 == 0);
3565   return a0;
3566 }
3567 
3568 INLINE Lisp_Object
modiff_to_integer(modiff_count a)3569 modiff_to_integer (modiff_count a)
3570 {
3571   eassume (0 <= a && a >> 30 >> 30 == 0);
3572   return make_int (a);
3573 }
3574 
3575 /* Defined in data.c.  */
3576 extern AVOID wrong_choice (Lisp_Object, Lisp_Object);
3577 extern void notify_variable_watchers (Lisp_Object, Lisp_Object,
3578 				      Lisp_Object, Lisp_Object);
3579 extern Lisp_Object indirect_function (Lisp_Object);
3580 extern Lisp_Object find_symbol_value (Lisp_Object);
3581 enum Arith_Comparison {
3582   ARITH_EQUAL,
3583   ARITH_NOTEQUAL,
3584   ARITH_LESS,
3585   ARITH_GRTR,
3586   ARITH_LESS_OR_EQUAL,
3587   ARITH_GRTR_OR_EQUAL
3588 };
3589 extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
3590                                  enum Arith_Comparison comparison);
3591 
3592 /* Convert the Emacs representation CONS back to an integer of type
3593    TYPE, storing the result the variable VAR.  Signal an error if CONS
3594    is not a valid representation or is out of range for TYPE.  */
3595 #define CONS_TO_INTEGER(cons, type, var)				\
3596  (TYPE_SIGNED (type)							\
3597   ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \
3598   : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type))))
3599 extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
3600 extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
3601 
3602 extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
3603 extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
3604 extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
3605 extern AVOID circular_list (Lisp_Object);
3606 extern Lisp_Object do_symval_forwarding (lispfwd);
3607 enum Set_Internal_Bind {
3608   SET_INTERNAL_SET,
3609   SET_INTERNAL_BIND,
3610   SET_INTERNAL_UNBIND,
3611   SET_INTERNAL_THREAD_SWITCH
3612 };
3613 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
3614                           enum Set_Internal_Bind);
3615 extern void set_default_internal (Lisp_Object, Lisp_Object,
3616                                   enum Set_Internal_Bind bindflag);
3617 extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
3618 extern void syms_of_data (void);
3619 extern void swap_in_global_binding (struct Lisp_Symbol *);
3620 
3621 /* Defined in cmds.c */
3622 extern void syms_of_cmds (void);
3623 extern void keys_of_cmds (void);
3624 
3625 /* Defined in coding.c.  */
3626 extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
3627                                          ptrdiff_t, bool, bool, Lisp_Object);
3628 extern void init_coding (void);
3629 extern void init_coding_once (void);
3630 extern void syms_of_coding (void);
3631 
3632 /* Defined in character.c.  */
3633 extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
3634 extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
3635 extern void syms_of_character (void);
3636 
3637 /* Defined in charset.c.  */
3638 extern void init_charset (void);
3639 extern void init_charset_once (void);
3640 extern void syms_of_charset (void);
3641 /* Structure forward declarations.  */
3642 struct charset;
3643 
3644 /* Defined in syntax.c.  */
3645 extern void init_syntax_once (void);
3646 extern void syms_of_syntax (void);
3647 
3648 /* Defined in fns.c.  */
3649 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
3650 extern ptrdiff_t list_length (Lisp_Object);
3651 extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
3652 extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
3653 extern bool sweep_weak_table (struct Lisp_Hash_Table *, bool);
3654 extern void hexbuf_digest (char *, void const *, int);
3655 extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
3656 EMACS_UINT hash_string (char const *, ptrdiff_t);
3657 EMACS_UINT sxhash (Lisp_Object, int);
3658 Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *);
3659 Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *);
3660 Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
3661 Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
3662                              Lisp_Object, bool);
3663 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *);
3664 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3665 		    Lisp_Object);
3666 void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
3667 extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
3668 extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
3669 			       ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
3670 extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
3671 				   ptrdiff_t, ptrdiff_t);
3672 extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
3673 extern Lisp_Object do_yes_or_no_p (Lisp_Object);
3674 extern int string_version_cmp (Lisp_Object, Lisp_Object);
3675 extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
3676 extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
3677 extern bool equal_no_quit (Lisp_Object, Lisp_Object);
3678 extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
3679 extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
3680 extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
3681 extern void clear_string_char_byte_cache (void);
3682 extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
3683 extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
3684 extern Lisp_Object string_to_multibyte (Lisp_Object);
3685 extern Lisp_Object string_make_unibyte (Lisp_Object);
3686 extern void syms_of_fns (void);
3687 
3688 /* Defined in floatfns.c.  */
3689 verify (FLT_RADIX == 2 || FLT_RADIX == 16);
3690 enum { LOG2_FLT_RADIX = FLT_RADIX == 2 ? 1 : 4 };
3691 int double_integer_scale (double);
3692 #ifndef HAVE_TRUNC
3693 extern double trunc (double);
3694 #endif
3695 extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
3696 extern void syms_of_floatfns (void);
3697 
3698 /* Defined in fringe.c.  */
3699 extern void syms_of_fringe (void);
3700 extern void init_fringe (void);
3701 #ifdef HAVE_WINDOW_SYSTEM
3702 extern void mark_fringe_data (void);
3703 extern void init_fringe_once (void);
3704 #endif /* HAVE_WINDOW_SYSTEM */
3705 
3706 /* Defined in image.c.  */
3707 extern int x_bitmap_mask (struct frame *, ptrdiff_t);
3708 extern void syms_of_image (void);
3709 
3710 #ifdef HAVE_JSON
3711 /* Defined in json.c.  */
3712 extern void init_json (void);
3713 extern void syms_of_json (void);
3714 #endif
3715 
3716 /* Defined in insdel.c.  */
3717 extern void move_gap_both (ptrdiff_t, ptrdiff_t);
3718 extern AVOID buffer_overflow (void);
3719 extern void make_gap (ptrdiff_t);
3720 extern void make_gap_1 (struct buffer *, ptrdiff_t);
3721 extern ptrdiff_t copy_text (const unsigned char *, unsigned char *,
3722 			    ptrdiff_t, bool, bool);
3723 extern int count_combining_before (const unsigned char *,
3724 				   ptrdiff_t, ptrdiff_t, ptrdiff_t);
3725 extern int count_combining_after (const unsigned char *,
3726 				  ptrdiff_t, ptrdiff_t, ptrdiff_t);
3727 extern void insert (const char *, ptrdiff_t);
3728 extern void insert_and_inherit (const char *, ptrdiff_t);
3729 extern void insert_1_both (const char *, ptrdiff_t, ptrdiff_t,
3730 			   bool, bool, bool);
3731 extern void insert_from_gap_1 (ptrdiff_t, ptrdiff_t, bool text_at_gap_tail);
3732 extern void insert_from_gap (ptrdiff_t, ptrdiff_t, bool text_at_gap_tail);
3733 extern void insert_from_string (Lisp_Object, ptrdiff_t, ptrdiff_t,
3734 				ptrdiff_t, ptrdiff_t, bool);
3735 extern void insert_from_buffer (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
3736 extern void insert_char (int);
3737 extern void insert_string (const char *);
3738 extern void insert_before_markers (const char *, ptrdiff_t);
3739 extern void insert_before_markers_and_inherit (const char *, ptrdiff_t);
3740 extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
3741 					       ptrdiff_t, ptrdiff_t,
3742 					       ptrdiff_t, bool);
3743 extern void del_range (ptrdiff_t, ptrdiff_t);
3744 extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
3745 extern void del_range_byte (ptrdiff_t, ptrdiff_t);
3746 extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
3747 extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
3748 				ptrdiff_t, ptrdiff_t, bool);
3749 extern void modify_text (ptrdiff_t, ptrdiff_t);
3750 extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
3751 extern void prepare_to_modify_buffer_1 (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
3752 extern void invalidate_buffer_caches (struct buffer *, ptrdiff_t, ptrdiff_t);
3753 extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
3754 extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3755 				 ptrdiff_t, ptrdiff_t);
3756 extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
3757 				       ptrdiff_t, ptrdiff_t);
3758 extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t,
3759 				    ptrdiff_t, ptrdiff_t, int);
3760 extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool, bool);
3761 extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
3762 			     const char *, ptrdiff_t, ptrdiff_t, bool);
3763 extern void syms_of_insdel (void);
3764 
3765 /* Defined in dispnew.c.  */
3766 #ifdef PROFILING
3767 _Noreturn void __executable_start (void);
3768 #endif
3769 extern Lisp_Object Vwindow_system;
3770 extern Lisp_Object sit_for (Lisp_Object, bool, int);
3771 
3772 /* Defined in xdisp.c.  */
3773 extern bool noninteractive_need_newline;
3774 extern Lisp_Object echo_area_buffer[2];
3775 extern void add_to_log (char const *, ...);
3776 extern void vadd_to_log (char const *, va_list);
3777 extern void check_message_stack (void);
3778 extern void setup_echo_area_for_printing (bool);
3779 extern bool push_message (void);
3780 extern void pop_message_unwind (void);
3781 extern Lisp_Object restore_message_unwind (Lisp_Object);
3782 extern void restore_message (void);
3783 extern Lisp_Object current_message (void);
3784 extern void clear_message (bool, bool);
3785 extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
3786 extern void message1 (const char *);
3787 extern void message1_nolog (const char *);
3788 extern void message3 (Lisp_Object);
3789 extern void message3_nolog (Lisp_Object);
3790 extern void message_dolog (const char *, ptrdiff_t, bool, bool);
3791 extern void message_with_string (const char *, Lisp_Object, bool);
3792 extern void message_log_maybe_newline (void);
3793 extern void update_echo_area (void);
3794 extern void truncate_echo_area (ptrdiff_t);
3795 extern void redisplay (void);
3796 
3797 void set_frame_cursor_types (struct frame *, Lisp_Object);
3798 extern void syms_of_xdisp (void);
3799 extern void init_xdisp (void);
3800 extern Lisp_Object safe_eval (Lisp_Object);
3801 extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
3802 			   int *, int *, int *, int *, int *);
3803 
3804 /* Defined in xsettings.c.  */
3805 extern void syms_of_xsettings (void);
3806 
3807 /* Defined in vm-limit.c.  */
3808 extern void memory_warnings (void *, void (*warnfun) (const char *));
3809 
3810 /* Defined in character.c.  */
3811 extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
3812 				    ptrdiff_t *, ptrdiff_t *);
3813 
3814 /* Defined in alloc.c.  */
3815 extern void *my_heap_start (void);
3816 extern void check_pure_size (void);
3817 extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
3818 extern void malloc_warning (const char *);
3819 extern AVOID memory_full (size_t);
3820 extern AVOID buffer_memory_full (ptrdiff_t);
3821 extern bool survives_gc_p (Lisp_Object);
3822 extern void mark_object (Lisp_Object);
3823 #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
3824 extern void refill_memory_reserve (void);
3825 #endif
3826 extern void alloc_unexec_pre (void);
3827 extern void alloc_unexec_post (void);
3828 extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
3829 extern void mark_stack (char const *, char const *);
3830 extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
3831 extern void garbage_collect (void);
3832 extern void maybe_garbage_collect (void);
3833 extern const char *pending_malloc_warning;
3834 extern Lisp_Object zero_vector;
3835 extern EMACS_INT consing_until_gc;
3836 #ifdef HAVE_PDUMPER
3837 extern int number_finalizers_run;
3838 #endif
3839 extern Lisp_Object list1 (Lisp_Object);
3840 extern Lisp_Object list2 (Lisp_Object, Lisp_Object);
3841 extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
3842 extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3843 extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
3844 			  Lisp_Object);
3845 extern Lisp_Object listn (ptrdiff_t, Lisp_Object, ...);
3846 extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...);
3847 #define list(...) \
3848   listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__)
3849 #define pure_list(...) \
3850   pure_listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__)
3851 
3852 enum gc_root_type
3853 {
3854   GC_ROOT_STATICPRO,
3855   GC_ROOT_BUFFER_LOCAL_DEFAULT,
3856   GC_ROOT_BUFFER_LOCAL_NAME,
3857   GC_ROOT_C_SYMBOL
3858 };
3859 
3860 struct gc_root_visitor
3861 {
3862   void (*visit) (Lisp_Object const *, enum gc_root_type, void *);
3863   void *data;
3864 };
3865 extern void visit_static_gc_roots (struct gc_root_visitor visitor);
3866 
3867 /* Build a frequently used 1/2/3/4-integer lists.  */
3868 
3869 INLINE Lisp_Object
list1i(intmax_t a)3870 list1i (intmax_t a)
3871 {
3872   return list1 (make_int (a));
3873 }
3874 
3875 INLINE Lisp_Object
list2i(intmax_t a,intmax_t b)3876 list2i (intmax_t a, intmax_t b)
3877 {
3878   return list2 (make_int (a), make_int (b));
3879 }
3880 
3881 INLINE Lisp_Object
list3i(intmax_t a,intmax_t b,intmax_t c)3882 list3i (intmax_t a, intmax_t b, intmax_t c)
3883 {
3884   return list3 (make_int (a), make_int (b), make_int (c));
3885 }
3886 
3887 INLINE Lisp_Object
list4i(intmax_t a,intmax_t b,intmax_t c,intmax_t d)3888 list4i (intmax_t a, intmax_t b, intmax_t c, intmax_t d)
3889 {
3890   return list4 (make_int (a), make_int (b), make_int (c), make_int (d));
3891 }
3892 
3893 extern Lisp_Object make_uninit_bool_vector (EMACS_INT);
3894 extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object);
3895 extern AVOID string_overflow (void);
3896 extern Lisp_Object make_string (const char *, ptrdiff_t);
3897 extern Lisp_Object make_formatted_string (char *, const char *, ...)
3898   ATTRIBUTE_FORMAT_PRINTF (2, 3);
3899 extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
3900 extern ptrdiff_t vectorlike_nbytes (const union vectorlike_header *hdr);
3901 
3902 INLINE ptrdiff_t
vector_nbytes(const struct Lisp_Vector * v)3903 vector_nbytes (const struct Lisp_Vector *v)
3904 {
3905   return vectorlike_nbytes (&v->header);
3906 }
3907 
3908 /* Make unibyte string from C string when the length isn't known.  */
3909 
3910 INLINE Lisp_Object
build_unibyte_string(const char * str)3911 build_unibyte_string (const char *str)
3912 {
3913   return make_unibyte_string (str, strlen (str));
3914 }
3915 
3916 extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
3917 extern Lisp_Object make_event_array (ptrdiff_t, Lisp_Object *);
3918 extern Lisp_Object make_uninit_string (EMACS_INT);
3919 extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
3920 extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
3921 extern Lisp_Object make_specified_string (const char *,
3922 					  ptrdiff_t, ptrdiff_t, bool);
3923 extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
3924 extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
3925 
3926 /* Make a string allocated in pure space, use STR as string data.  */
3927 
3928 INLINE Lisp_Object
build_pure_c_string(const char * str)3929 build_pure_c_string (const char *str)
3930 {
3931   return make_pure_c_string (str, strlen (str));
3932 }
3933 
3934 /* Make a string from the data at STR, treating it as multibyte if the
3935    data warrants.  */
3936 
3937 INLINE Lisp_Object
build_string(const char * str)3938 build_string (const char *str)
3939 {
3940   return make_string (str, strlen (str));
3941 }
3942 
3943 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
3944 extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
3945 extern void make_byte_code (struct Lisp_Vector *);
3946 extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
3947 
3948 /* Make an uninitialized vector for SIZE objects.  NOTE: you must
3949    be sure that GC cannot happen until the vector is completely
3950    initialized.  E.g. the following code is likely to crash:
3951 
3952    v = make_uninit_vector (3);
3953    ASET (v, 0, obj0);
3954    ASET (v, 1, Ffunction_can_gc ());
3955    ASET (v, 2, obj1);  */
3956 
3957 INLINE Lisp_Object
make_uninit_vector(ptrdiff_t size)3958 make_uninit_vector (ptrdiff_t size)
3959 {
3960   return make_lisp_ptr (allocate_vector (size), Lisp_Vectorlike);
3961 }
3962 
3963 /* Like above, but special for sub char-tables.  */
3964 
3965 INLINE Lisp_Object
make_uninit_sub_char_table(int depth,int min_char)3966 make_uninit_sub_char_table (int depth, int min_char)
3967 {
3968   int slots = SUB_CHAR_TABLE_OFFSET + chartab_size[depth];
3969   Lisp_Object v = make_uninit_vector (slots);
3970 
3971   XSETPVECTYPE (XVECTOR (v), PVEC_SUB_CHAR_TABLE);
3972   XSUB_CHAR_TABLE (v)->depth = depth;
3973   XSUB_CHAR_TABLE (v)->min_char = min_char;
3974   return v;
3975 }
3976 
3977 /* Make a vector of SIZE nils.  */
3978 
3979 INLINE Lisp_Object
make_nil_vector(ptrdiff_t size)3980 make_nil_vector (ptrdiff_t size)
3981 {
3982   Lisp_Object vec = make_uninit_vector (size);
3983   memclear (XVECTOR (vec)->contents, size * word_size);
3984   return vec;
3985 }
3986 
3987 extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
3988 						  enum pvec_type);
3989 
3990 /* Allocate uninitialized pseudovector with no Lisp_Object slots.  */
3991 
3992 #define ALLOCATE_PLAIN_PSEUDOVECTOR(type, tag) \
3993   ((type *) allocate_pseudovector (VECSIZE (type), 0, 0, tag))
3994 
3995 /* Allocate partially initialized pseudovector where all Lisp_Object
3996    slots are set to Qnil but the rest (if any) is left uninitialized.  */
3997 
3998 #define ALLOCATE_PSEUDOVECTOR(type, field, tag)			       \
3999   ((type *) allocate_pseudovector (VECSIZE (type),		       \
4000 				   PSEUDOVECSIZE (type, field),	       \
4001 				   PSEUDOVECSIZE (type, field), tag))
4002 
4003 /* Allocate fully initialized pseudovector where all Lisp_Object
4004    slots are set to Qnil and the rest (if any) is zeroed.  */
4005 
4006 #define ALLOCATE_ZEROED_PSEUDOVECTOR(type, field, tag)		       \
4007   ((type *) allocate_pseudovector (VECSIZE (type),		       \
4008 				   PSEUDOVECSIZE (type, field),	       \
4009 				   VECSIZE (type), tag))
4010 
4011 extern bool gc_in_progress;
4012 extern Lisp_Object make_float (double);
4013 extern void display_malloc_warning (void);
4014 extern ptrdiff_t inhibit_garbage_collection (void);
4015 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
4016 extern void free_cons (struct Lisp_Cons *);
4017 extern void init_alloc_once (void);
4018 extern void init_alloc (void);
4019 extern void syms_of_alloc (void);
4020 extern struct buffer * allocate_buffer (void);
4021 extern int valid_lisp_object_p (Lisp_Object);
4022 
4023 /* Defined in gmalloc.c.  */
4024 #if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC
4025 extern size_t __malloc_extra_blocks;
4026 #endif
4027 #if !HAVE_DECL_ALIGNED_ALLOC
4028 extern void *aligned_alloc (size_t, size_t) ATTRIBUTE_MALLOC_SIZE ((2));
4029 #endif
4030 extern void malloc_enable_thread (void);
4031 
4032 #ifdef REL_ALLOC
4033 /* Defined in ralloc.c.  */
4034 extern void *r_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
4035 extern void r_alloc_free (void **);
4036 extern void *r_re_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
4037 extern void r_alloc_reset_variable (void **, void **);
4038 extern void r_alloc_inhibit_buffer_relocation (int);
4039 #endif
4040 
4041 /* Defined in chartab.c.  */
4042 extern Lisp_Object copy_char_table (Lisp_Object);
4043 extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
4044                                              int *, int *);
4045 extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
4046 extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
4047                             Lisp_Object),
4048                             Lisp_Object, Lisp_Object, Lisp_Object);
4049 extern void map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
4050 					Lisp_Object, Lisp_Object,
4051 					Lisp_Object, struct charset *,
4052 					unsigned, unsigned);
4053 extern Lisp_Object uniprop_table (Lisp_Object);
4054 extern Lisp_Object get_unicode_property (Lisp_Object, int);
4055 extern void syms_of_chartab (void);
4056 
4057 /* Defined in print.c.  */
4058 extern Lisp_Object Vprin1_to_string_buffer;
4059 extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
4060 extern void temp_output_buffer_setup (const char *);
4061 extern int print_level;
4062 extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
4063 				 Lisp_Object);
4064 extern Lisp_Object internal_with_output_to_temp_buffer
4065         (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
4066 #define FLOAT_TO_STRING_BUFSIZE 350
4067 extern int float_to_string (char *, double);
4068 extern void init_print_once (void);
4069 extern void syms_of_print (void);
4070 
4071 /* Defined in doprnt.c.  */
4072 extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
4073 			 va_list);
4074 extern ptrdiff_t esprintf (char *, char const *, ...)
4075   ATTRIBUTE_FORMAT_PRINTF (2, 3);
4076 extern ptrdiff_t exprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
4077 			   char const *, ...)
4078   ATTRIBUTE_FORMAT_PRINTF (5, 6);
4079 extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
4080 			    char const *, va_list)
4081   ATTRIBUTE_FORMAT_PRINTF (5, 0);
4082 
4083 /* Defined in lread.c.  */
4084 extern Lisp_Object check_obarray (Lisp_Object);
4085 extern Lisp_Object intern_1 (const char *, ptrdiff_t);
4086 extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
4087 extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
4088 extern void init_symbol (Lisp_Object, Lisp_Object);
4089 extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
4090 INLINE void
LOADHIST_ATTACH(Lisp_Object x)4091 LOADHIST_ATTACH (Lisp_Object x)
4092 {
4093   if (initialized)
4094     Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
4095 }
4096 extern Lisp_Object save_match_data_load (Lisp_Object, Lisp_Object, Lisp_Object,
4097 					 Lisp_Object, Lisp_Object);
4098 extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
4099                   Lisp_Object *, Lisp_Object, bool);
4100 enum { S2N_IGNORE_TRAILING = 1 };
4101 extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *);
4102 extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
4103                          Lisp_Object);
4104 extern void dir_warning (const char *, Lisp_Object);
4105 extern void init_obarray_once (void);
4106 extern void init_lread (void);
4107 extern void syms_of_lread (void);
4108 
4109 INLINE Lisp_Object
intern(const char * str)4110 intern (const char *str)
4111 {
4112   return intern_1 (str, strlen (str));
4113 }
4114 
4115 INLINE Lisp_Object
intern_c_string(const char * str)4116 intern_c_string (const char *str)
4117 {
4118   return intern_c_string_1 (str, strlen (str));
4119 }
4120 
4121 /* Defined in eval.c.  */
4122 extern Lisp_Object Vautoload_queue;
4123 extern Lisp_Object Vrun_hooks;
4124 extern Lisp_Object Vsignaling_function;
4125 extern Lisp_Object inhibit_lisp_code;
4126 
4127 /* To run a normal hook, use the appropriate function from the list below.
4128    The calling convention:
4129 
4130    if (!NILP (Vrun_hooks))
4131      call1 (Vrun_hooks, Qmy_funny_hook);
4132 
4133    should no longer be used.  */
4134 extern void run_hook (Lisp_Object);
4135 extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
4136 extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
4137 				       Lisp_Object (*funcall)
4138 				       (ptrdiff_t nargs, Lisp_Object *args));
4139 extern Lisp_Object quit (void);
4140 INLINE AVOID
xsignal(Lisp_Object error_symbol,Lisp_Object data)4141 xsignal (Lisp_Object error_symbol, Lisp_Object data)
4142 {
4143   Fsignal (error_symbol, data);
4144 }
4145 extern AVOID xsignal0 (Lisp_Object);
4146 extern AVOID xsignal1 (Lisp_Object, Lisp_Object);
4147 extern AVOID xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
4148 extern AVOID xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4149 extern AVOID signal_error (const char *, Lisp_Object);
4150 extern AVOID overflow_error (void);
4151 extern bool FUNCTIONP (Lisp_Object);
4152 extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
4153 extern Lisp_Object eval_sub (Lisp_Object form);
4154 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
4155 extern Lisp_Object call0 (Lisp_Object);
4156 extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
4157 extern Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object);
4158 extern Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4159 extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4160 extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4161 extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4162 extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4163 extern Lisp_Object call8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4164 extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
4165 extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
4166 extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
4167 extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
4168 extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
4169 extern Lisp_Object internal_condition_case_n
4170     (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
4171      Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
4172 extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object));
4173 extern struct handler *push_handler (Lisp_Object, enum handlertype);
4174 extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
4175 extern void specbind (Lisp_Object, Lisp_Object);
4176 extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
4177 extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t);
4178 extern void record_unwind_protect_ptr (void (*) (void *), void *);
4179 extern void record_unwind_protect_int (void (*) (int), int);
4180 extern void record_unwind_protect_intmax (void (*) (intmax_t), intmax_t);
4181 extern void record_unwind_protect_void (void (*) (void));
4182 extern void record_unwind_protect_excursion (void);
4183 extern void record_unwind_protect_nothing (void);
4184 extern void clear_unwind_protect (ptrdiff_t);
4185 extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
4186 extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
4187 extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
4188 extern void rebind_for_thread_switch (void);
4189 extern void unbind_for_thread_switch (struct thread_state *);
4190 extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
4191 extern AVOID verror (const char *, va_list)
4192   ATTRIBUTE_FORMAT_PRINTF (1, 0);
4193 extern Lisp_Object vformat_string (const char *, va_list)
4194   ATTRIBUTE_FORMAT_PRINTF (1, 0);
4195 extern void un_autoload (Lisp_Object);
4196 extern Lisp_Object call_debugger (Lisp_Object arg);
4197 extern void init_eval_once (void);
4198 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
4199 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
4200 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
4201 extern void init_eval (void);
4202 extern void syms_of_eval (void);
4203 extern void prog_ignore (Lisp_Object);
4204 extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t);
4205 extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
4206 extern void get_backtrace (Lisp_Object array);
4207 Lisp_Object backtrace_top_function (void);
4208 extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
4209 
4210 /* Defined in unexmacosx.c.  */
4211 #if defined DARWIN_OS && defined HAVE_UNEXEC
4212 extern void unexec_init_emacs_zone (void);
4213 extern void *unexec_malloc (size_t);
4214 extern void *unexec_realloc (void *, size_t);
4215 extern void unexec_free (void *);
4216 #endif
4217 
4218 /* The definition of Lisp_Module_Function depends on emacs-module.h,
4219    so we don't define it here.  It's defined in emacs-module.c.  */
4220 
4221 INLINE bool
MODULE_FUNCTIONP(Lisp_Object o)4222 MODULE_FUNCTIONP (Lisp_Object o)
4223 {
4224   return PSEUDOVECTORP (o, PVEC_MODULE_FUNCTION);
4225 }
4226 
4227 INLINE struct Lisp_Module_Function *
XMODULE_FUNCTION(Lisp_Object o)4228 XMODULE_FUNCTION (Lisp_Object o)
4229 {
4230   eassert (MODULE_FUNCTIONP (o));
4231   return XUNTAG (o, Lisp_Vectorlike, struct Lisp_Module_Function);
4232 }
4233 
4234 #ifdef HAVE_MODULES
4235 /* A function pointer type good enough for lisp.h.  Actual module
4236    function pointers are of a different type that relies on details
4237    internal to emacs-module.c.  */
4238 typedef void (*module_funcptr) (void);
4239 
4240 /* Defined in alloc.c.  */
4241 extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
4242 
4243 /* Defined in emacs-module.c.  */
4244 extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
4245 extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
4246 extern Lisp_Object module_function_documentation
4247   (struct Lisp_Module_Function const *);
4248 extern module_funcptr module_function_address
4249   (struct Lisp_Module_Function const *);
4250 extern void mark_modules (void);
4251 extern void init_module_assertions (bool);
4252 extern void syms_of_module (void);
4253 #endif
4254 
4255 /* Defined in thread.c.  */
4256 extern void mark_threads (void);
4257 extern void unmark_main_thread (void);
4258 
4259 /* Defined in editfns.c.  */
4260 extern void insert1 (Lisp_Object);
4261 extern void save_excursion_save (union specbinding *);
4262 extern void save_excursion_restore (Lisp_Object, Lisp_Object);
4263 extern Lisp_Object save_restriction_save (void);
4264 extern void save_restriction_restore (Lisp_Object);
4265 extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
4266 extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
4267 					    ptrdiff_t, bool);
4268 extern void init_editfns (void);
4269 extern void syms_of_editfns (void);
4270 
4271 /* Defined in buffer.c.  */
4272 extern bool mouse_face_overlay_overlaps (Lisp_Object);
4273 extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
4274 extern AVOID nsberror (Lisp_Object);
4275 extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
4276 extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
4277 extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
4278 extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
4279                                          Lisp_Object, Lisp_Object, Lisp_Object);
4280 extern bool overlay_touches_p (ptrdiff_t);
4281 extern Lisp_Object other_buffer_safely (Lisp_Object);
4282 extern Lisp_Object get_truename_buffer (Lisp_Object);
4283 extern void init_buffer_once (void);
4284 extern void init_buffer (void);
4285 extern void syms_of_buffer (void);
4286 extern void keys_of_buffer (void);
4287 
4288 /* Defined in marker.c.  */
4289 
4290 extern ptrdiff_t marker_position (Lisp_Object);
4291 extern ptrdiff_t marker_byte_position (Lisp_Object);
4292 extern void clear_charpos_cache (struct buffer *);
4293 extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
4294 extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
4295 extern void detach_marker (Lisp_Object);
4296 extern void unchain_marker (struct Lisp_Marker *);
4297 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
4298 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
4299 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
4300                                                ptrdiff_t, ptrdiff_t);
4301 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
4302 extern void syms_of_marker (void);
4303 
4304 /* Defined in fileio.c.  */
4305 
4306 extern char *splice_dir_file (char *, char const *, char const *);
4307 extern bool file_name_absolute_p (const char *);
4308 extern char const *get_homedir (void);
4309 extern Lisp_Object expand_and_dir_to_file (Lisp_Object);
4310 extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
4311 				 Lisp_Object, Lisp_Object, Lisp_Object,
4312 				 Lisp_Object, int);
4313 extern void close_file_unwind (int);
4314 extern void fclose_unwind (void *);
4315 extern void restore_point_unwind (Lisp_Object);
4316 extern bool file_access_p (char const *, int);
4317 extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int);
4318 extern AVOID report_file_errno (const char *, Lisp_Object, int);
4319 extern AVOID report_file_error (const char *, Lisp_Object);
4320 extern AVOID report_file_notify_error (const char *, Lisp_Object);
4321 extern Lisp_Object file_attribute_errno (Lisp_Object, int);
4322 extern bool internal_delete_file (Lisp_Object);
4323 extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *);
4324 extern bool file_directory_p (Lisp_Object);
4325 extern bool file_accessible_directory_p (Lisp_Object);
4326 extern void init_fileio (void);
4327 extern void syms_of_fileio (void);
4328 
4329 /* Defined in search.c.  */
4330 extern void shrink_regexp_cache (void);
4331 extern void restore_search_regs (void);
4332 extern void update_search_regs (ptrdiff_t oldstart,
4333                                 ptrdiff_t oldend, ptrdiff_t newend);
4334 extern void record_unwind_save_match_data (void);
4335 extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object,
4336 					     Lisp_Object);
4337 
4338 INLINE ptrdiff_t
fast_string_match(Lisp_Object regexp,Lisp_Object string)4339 fast_string_match (Lisp_Object regexp, Lisp_Object string)
4340 {
4341   return fast_string_match_internal (regexp, string, Qnil);
4342 }
4343 
4344 INLINE ptrdiff_t
fast_string_match_ignore_case(Lisp_Object regexp,Lisp_Object string)4345 fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
4346 {
4347   return fast_string_match_internal (regexp, string, Vascii_canon_table);
4348 }
4349 
4350 extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *,
4351 						  ptrdiff_t);
4352 extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t,
4353                                   ptrdiff_t, ptrdiff_t, Lisp_Object);
4354 extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
4355 			       ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
4356 extern void scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
4357 			  ptrdiff_t, bool);
4358 extern ptrdiff_t scan_newline_from_point (ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
4359 extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t,
4360 				       ptrdiff_t, ptrdiff_t *);
4361 extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t,
4362 					   ptrdiff_t, ptrdiff_t *);
4363 extern void syms_of_search (void);
4364 extern void clear_regexp_cache (void);
4365 
4366 /* Defined in minibuf.c.  */
4367 
4368 extern Lisp_Object Vminibuffer_list;
4369 extern Lisp_Object last_minibuf_string;
4370 extern Lisp_Object get_minibuffer (EMACS_INT);
4371 extern void init_minibuf_once (void);
4372 extern void syms_of_minibuf (void);
4373 
4374 /* Defined in callint.c.  */
4375 
4376 extern void syms_of_callint (void);
4377 
4378 /* Defined in casefiddle.c.  */
4379 
4380 extern void syms_of_casefiddle (void);
4381 extern void keys_of_casefiddle (void);
4382 
4383 /* Defined in casetab.c.  */
4384 
4385 extern void init_casetab_once (void);
4386 extern void syms_of_casetab (void);
4387 
4388 /* Defined in keyboard.c.  */
4389 
4390 extern Lisp_Object echo_message_buffer;
4391 extern struct kboard *echo_kboard;
4392 extern void cancel_echoing (void);
4393 extern bool input_pending;
4394 #ifdef HAVE_STACK_OVERFLOW_HANDLING
4395 extern sigjmp_buf return_to_command_loop;
4396 #endif
4397 extern Lisp_Object menu_bar_items (Lisp_Object);
4398 extern Lisp_Object tab_bar_items (Lisp_Object, int *);
4399 extern Lisp_Object tool_bar_items (Lisp_Object, int *);
4400 extern void discard_mouse_events (void);
4401 #ifdef USABLE_SIGIO
4402 void handle_input_available_signal (int);
4403 #endif
4404 extern Lisp_Object pending_funcalls;
4405 extern bool detect_input_pending (void);
4406 extern bool detect_input_pending_ignore_squeezables (void);
4407 extern bool detect_input_pending_run_timers (bool);
4408 extern void safe_run_hooks (Lisp_Object);
4409 extern void cmd_error_internal (Lisp_Object, const char *);
4410 extern Lisp_Object command_loop_1 (void);
4411 extern Lisp_Object read_menu_command (void);
4412 extern Lisp_Object recursive_edit_1 (void);
4413 extern void record_auto_save (void);
4414 extern void force_auto_save_soon (void);
4415 extern void init_keyboard (void);
4416 extern void syms_of_keyboard (void);
4417 extern void keys_of_keyboard (void);
4418 
4419 /* Defined in indent.c.  */
4420 extern ptrdiff_t current_column (void);
4421 extern void invalidate_current_column (void);
4422 extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT);
4423 extern void syms_of_indent (void);
4424 
4425 /* Defined in frame.c.  */
4426 extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
4427 extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
4428 extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
4429 extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
4430 extern void frames_discard_buffer (Lisp_Object);
4431 extern void init_frame_once (void);
4432 extern void syms_of_frame (void);
4433 
4434 /* Defined in emacs.c.  */
4435 extern char **initial_argv;
4436 extern int initial_argc;
4437 extern char const *emacs_wd;
4438 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
4439 extern bool display_arg;
4440 #endif
4441 extern Lisp_Object decode_env_path (const char *, const char *, bool);
4442 extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
4443 extern AVOID terminate_due_to_signal (int, int);
4444 #ifdef WINDOWSNT
4445 extern Lisp_Object Vlibrary_cache;
4446 #endif
4447 #if HAVE_SETLOCALE
4448 void fixup_locale (void);
4449 void synchronize_system_messages_locale (void);
4450 void synchronize_system_time_locale (void);
4451 #else
fixup_locale(void)4452 INLINE void fixup_locale (void) {}
synchronize_system_messages_locale(void)4453 INLINE void synchronize_system_messages_locale (void) {}
synchronize_system_time_locale(void)4454 INLINE void synchronize_system_time_locale (void) {}
4455 #endif
4456 extern char *emacs_strerror (int);
4457 extern void shut_down_emacs (int, Lisp_Object);
4458 
4459 /* True means don't do interactive redisplay and don't change tty modes.  */
4460 extern bool noninteractive;
4461 
4462 /* True means remove site-lisp directories from load-path.  */
4463 extern bool no_site_lisp;
4464 
4465 /* True means put details like time stamps into builds.  */
4466 extern bool build_details;
4467 
4468 #ifndef WINDOWSNT
4469 /* 0 not a daemon, 1 foreground daemon, 2 background daemon.  */
4470 extern int daemon_type;
4471 #define IS_DAEMON (daemon_type != 0)
4472 #define DAEMON_RUNNING (daemon_type >= 0)
4473 #else  /* WINDOWSNT */
4474 extern void *w32_daemon_event;
4475 #define IS_DAEMON (w32_daemon_event != NULL)
4476 #define DAEMON_RUNNING (w32_daemon_event != INVALID_HANDLE_VALUE)
4477 #endif
4478 
4479 /* True if handling a fatal error already.  */
4480 extern bool fatal_error_in_progress;
4481 
4482 /* True means don't do use window-system-specific display code.  */
4483 extern bool inhibit_window_system;
4484 /* True means that a filter or a sentinel is running.  */
4485 extern bool running_asynch_code;
4486 
4487 /* Defined in process.c.  */
4488 struct Lisp_Process;
4489 extern void kill_buffer_processes (Lisp_Object);
4490 extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object,
4491 					struct Lisp_Process *, int);
4492 /* Max value for the first argument of wait_reading_process_output.  */
4493 #if GNUC_PREREQ (3, 0, 0) && ! GNUC_PREREQ (4, 6, 0)
4494 /* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.0.
4495    The bug merely causes a bogus warning, but the warning is annoying.  */
4496 # define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
4497 #else
4498 # define WAIT_READING_MAX INTMAX_MAX
4499 #endif
4500 #ifdef HAVE_TIMERFD
4501 extern void add_timer_wait_descriptor (int);
4502 #endif
4503 extern void add_keyboard_wait_descriptor (int);
4504 extern void delete_keyboard_wait_descriptor (int);
4505 #ifdef HAVE_GPM
4506 extern void add_gpm_wait_descriptor (int);
4507 extern void delete_gpm_wait_descriptor (int);
4508 #endif
4509 extern void init_process_emacs (int);
4510 extern void syms_of_process (void);
4511 extern void setup_process_coding_systems (Lisp_Object);
4512 
4513 /* Defined in callproc.c.  */
4514 #ifdef DOS_NT
4515 # define CHILD_SETUP_TYPE int
4516 # define CHILD_SETUP_ERROR_DESC "Spawning child process"
4517 #else
4518 # define CHILD_SETUP_TYPE _Noreturn void
4519 # define CHILD_SETUP_ERROR_DESC "Doing vfork"
4520 #endif
4521 
4522 extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object);
4523 extern void init_callproc_1 (void);
4524 extern void init_callproc (void);
4525 extern void set_initial_environment (void);
4526 extern void syms_of_callproc (void);
4527 
4528 /* Defined in doc.c.  */
4529 enum text_quoting_style
4530   {
4531     /* Use curved single quotes ‘like this’.  */
4532     CURVE_QUOTING_STYLE,
4533 
4534     /* Use grave accent and apostrophe  `like this'.  */
4535     GRAVE_QUOTING_STYLE,
4536 
4537     /* Use apostrophes 'like this'.  */
4538     STRAIGHT_QUOTING_STYLE
4539   };
4540 extern enum text_quoting_style text_quoting_style (void);
4541 extern Lisp_Object read_doc_string (Lisp_Object);
4542 extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
4543 extern void syms_of_doc (void);
4544 extern int read_bytecode_char (bool);
4545 
4546 /* Defined in bytecode.c.  */
4547 extern void syms_of_bytecode (void);
4548 extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
4549 				   Lisp_Object, ptrdiff_t, Lisp_Object *);
4550 extern Lisp_Object get_byte_code_arity (Lisp_Object);
4551 
4552 /* Defined in macros.c.  */
4553 extern void init_macros (void);
4554 extern void syms_of_macros (void);
4555 
4556 /* Defined in undo.c.  */
4557 extern void truncate_undo_list (struct buffer *);
4558 extern void record_insert (ptrdiff_t, ptrdiff_t);
4559 extern void record_delete (ptrdiff_t, Lisp_Object, bool);
4560 extern void record_first_change (void);
4561 extern void record_change (ptrdiff_t, ptrdiff_t);
4562 extern void record_property_change (ptrdiff_t, ptrdiff_t,
4563 				    Lisp_Object, Lisp_Object,
4564                                     Lisp_Object);
4565 extern void syms_of_undo (void);
4566 
4567 /* Defined in textprop.c.  */
4568 extern void report_interval_modification (Lisp_Object, Lisp_Object);
4569 
4570 /* Defined in menu.c.  */
4571 extern void syms_of_menu (void);
4572 
4573 /* Defined in xmenu.c.  */
4574 extern void syms_of_xmenu (void);
4575 
4576 /* Defined in termchar.h.  */
4577 struct tty_display_info;
4578 
4579 /* Defined in sysdep.c.  */
4580 #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
4581 extern int maybe_disable_address_randomization (int, char **);
4582 #else
4583 INLINE int
maybe_disable_address_randomization(int argc,char ** argv)4584 maybe_disable_address_randomization (int argc, char **argv)
4585 {
4586   return argc;
4587 }
4588 #endif
4589 extern int emacs_exec_file (char const *, char *const *, char *const *);
4590 extern void init_standard_fds (void);
4591 extern char *emacs_get_current_dir_name (void);
4592 extern void stuff_char (char c);
4593 extern void init_foreground_group (void);
4594 extern void sys_subshell (void);
4595 extern void sys_suspend (void);
4596 extern void discard_tty_input (void);
4597 extern void init_sys_modes (struct tty_display_info *);
4598 extern void reset_sys_modes (struct tty_display_info *);
4599 extern void init_all_sys_modes (void);
4600 extern void reset_all_sys_modes (void);
4601 extern void child_setup_tty (int);
4602 extern void setup_pty (int);
4603 extern int set_window_size (int, int, int);
4604 extern EMACS_INT get_random (void);
4605 extern void seed_random (void *, ptrdiff_t);
4606 extern void init_random (void);
4607 extern void emacs_backtrace (int);
4608 extern AVOID emacs_abort (void) NO_INLINE;
4609 extern int emacs_open (const char *, int, int);
4610 extern int emacs_pipe (int[2]);
4611 extern int emacs_close (int);
4612 extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
4613 extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
4614 extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
4615 extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
4616 extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
4617 extern void emacs_perror (char const *);
4618 extern int renameat_noreplace (int, char const *, int, char const *);
4619 extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
4620 extern void syms_of_sysdep (void);
4621 
4622 /* Defined in filelock.c.  */
4623 extern void lock_file (Lisp_Object);
4624 extern void unlock_file (Lisp_Object);
4625 extern void unlock_all_files (void);
4626 extern void unlock_buffer (struct buffer *);
4627 extern void syms_of_filelock (void);
4628 
4629 /* Defined in sound.c.  */
4630 extern void syms_of_sound (void);
4631 
4632 /* Defined in category.c.  */
4633 extern void init_category_once (void);
4634 extern Lisp_Object char_category_set (int);
4635 extern void syms_of_category (void);
4636 
4637 /* Defined in ccl.c.  */
4638 extern void syms_of_ccl (void);
4639 
4640 /* Defined in dired.c.  */
4641 extern void syms_of_dired (void);
4642 extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
4643                                              Lisp_Object, Lisp_Object,
4644                                              bool, Lisp_Object);
4645 
4646 /* Defined in term.c.  */
4647 extern int *char_ins_del_vector;
4648 extern void syms_of_term (void);
4649 extern AVOID fatal (const char *msgid, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
4650 
4651 /* Defined in terminal.c.  */
4652 extern void syms_of_terminal (void);
4653 
4654 /* Defined in font.c.  */
4655 extern void syms_of_font (void);
4656 extern void init_font (void);
4657 
4658 #ifdef HAVE_WINDOW_SYSTEM
4659 /* Defined in fontset.c.  */
4660 extern void syms_of_fontset (void);
4661 #endif
4662 
4663 /* Defined in inotify.c */
4664 #ifdef HAVE_INOTIFY
4665 extern void syms_of_inotify (void);
4666 #endif
4667 
4668 /* Defined in kqueue.c */
4669 #ifdef HAVE_KQUEUE
4670 extern void globals_of_kqueue (void);
4671 extern void syms_of_kqueue (void);
4672 #endif
4673 
4674 /* Defined in gfilenotify.c */
4675 #ifdef HAVE_GFILENOTIFY
4676 extern void globals_of_gfilenotify (void);
4677 extern void syms_of_gfilenotify (void);
4678 #endif
4679 
4680 #ifdef HAVE_W32NOTIFY
4681 /* Defined on w32notify.c.  */
4682 extern void syms_of_w32notify (void);
4683 #endif
4684 
4685 #if defined HAVE_NTGUI || defined CYGWIN
4686 /* Defined in w32cygwinx.c.  */
4687 extern void syms_of_w32cygwinx (void);
4688 #endif
4689 
4690 /* Defined in xfaces.c.  */
4691 extern Lisp_Object Vface_alternative_font_family_alist;
4692 extern Lisp_Object Vface_alternative_font_registry_alist;
4693 extern void syms_of_xfaces (void);
4694 #ifdef HAVE_PDUMPER
4695 extern void init_xfaces (void);
4696 #endif
4697 
4698 #ifdef HAVE_X_WINDOWS
4699 /* Defined in xfns.c.  */
4700 extern void syms_of_xfns (void);
4701 
4702 /* Defined in xsmfns.c.  */
4703 extern void syms_of_xsmfns (void);
4704 
4705 /* Defined in xselect.c.  */
4706 extern void syms_of_xselect (void);
4707 
4708 /* Defined in xterm.c.  */
4709 extern void init_xterm (void);
4710 extern void syms_of_xterm (void);
4711 #endif /* HAVE_X_WINDOWS */
4712 
4713 #ifdef HAVE_WINDOW_SYSTEM
4714 /* Defined in xterm.c, nsterm.m, w32term.c.  */
4715 extern char *get_keysym_name (int);
4716 #endif /* HAVE_WINDOW_SYSTEM */
4717 
4718 /* Defined in xml.c.  */
4719 extern void syms_of_xml (void);
4720 #ifdef HAVE_LIBXML2
4721 extern void xml_cleanup_parser (void);
4722 #endif
4723 
4724 #ifdef HAVE_LCMS2
4725 /* Defined in lcms.c.  */
4726 extern void syms_of_lcms2 (void);
4727 #endif
4728 
4729 #ifdef HAVE_ZLIB
4730 /* Defined in decompress.c.  */
4731 extern void syms_of_decompress (void);
4732 #endif
4733 
4734 #ifdef HAVE_DBUS
4735 /* Defined in dbusbind.c.  */
4736 void init_dbusbind (void);
4737 void syms_of_dbusbind (void);
4738 #endif
4739 
4740 
4741 /* Defined in profiler.c.  */
4742 extern bool profiler_memory_running;
4743 extern void malloc_probe (size_t);
4744 extern void syms_of_profiler (void);
4745 
4746 
4747 #ifdef DOS_NT
4748 /* Defined in msdos.c, w32.c.  */
4749 extern char *emacs_root_dir (void);
4750 #endif /* DOS_NT */
4751 
4752 /* Defined in lastfile.c.  */
4753 extern char my_edata[];
4754 extern char my_endbss[];
4755 extern char *my_endbss_static;
4756 
4757 extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4758 extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4759 extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
4760 extern void xfree (void *);
4761 extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2));
4762 extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t)
4763   ATTRIBUTE_ALLOC_SIZE ((2,3));
4764 extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
4765 
4766 extern char *xstrdup (const char *) ATTRIBUTE_MALLOC;
4767 extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC;
4768 extern void dupstring (char **, char const *);
4769 
4770 /* Make DEST a copy of STRING's data.  Return a pointer to DEST's terminating
4771    NUL byte.  This is like stpcpy, except the source is a Lisp string.  */
4772 
4773 INLINE char *
lispstpcpy(char * dest,Lisp_Object string)4774 lispstpcpy (char *dest, Lisp_Object string)
4775 {
4776   ptrdiff_t len = SBYTES (string);
4777   memcpy (dest, SDATA (string), len + 1);
4778   return dest + len;
4779 }
4780 
4781 extern void xputenv (const char *);
4782 
4783 extern char *egetenv_internal (const char *, ptrdiff_t);
4784 
4785 INLINE char *
egetenv(const char * var)4786 egetenv (const char *var)
4787 {
4788   /* When VAR is a string literal, strlen can be optimized away.  */
4789   return egetenv_internal (var, strlen (var));
4790 }
4791 
4792 /* Set up the name of the machine we're running on.  */
4793 extern void init_system_name (void);
4794 
4795 /* Return the absolute value of X.  X should be a signed integer
4796    expression without side effects, and X's absolute value should not
4797    exceed the maximum for its promoted type.  This is called 'eabs'
4798    because 'abs' is reserved by the C standard.  */
4799 #define eabs(x)         ((x) < 0 ? -(x) : (x))
4800 
4801 /* SAFE_ALLOCA normally allocates memory on the stack, but if size is
4802    larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack.  */
4803 
4804 enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
4805 
4806 extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
4807 
4808 #define USE_SAFE_ALLOCA			\
4809   ptrdiff_t sa_avail = MAX_ALLOCA;	\
4810   ptrdiff_t sa_count = SPECPDL_INDEX ()
4811 
4812 #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size))
4813 
4814 /* SAFE_ALLOCA allocates a simple buffer.  */
4815 
4816 #define SAFE_ALLOCA(size) ((size) <= sa_avail				\
4817 			   ? AVAIL_ALLOCA (size)			\
4818 			   : record_xmalloc (size))
4819 
4820 /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
4821    NITEMS items, each of the same type as *BUF.  MULTIPLIER must
4822    positive.  The code is tuned for MULTIPLIER being a constant.  */
4823 
4824 #define SAFE_NALLOCA(buf, multiplier, nitems)			 \
4825   do {								 \
4826     if ((nitems) <= sa_avail / sizeof *(buf) / (multiplier))	 \
4827       (buf) = AVAIL_ALLOCA (sizeof *(buf) * (multiplier) * (nitems)); \
4828     else							 \
4829       {								 \
4830 	(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
4831 	record_unwind_protect_ptr (xfree, buf);			 \
4832       }								 \
4833   } while (false)
4834 
4835 /* SAFE_ALLOCA_STRING allocates a C copy of a Lisp string.  */
4836 
4837 #define SAFE_ALLOCA_STRING(ptr, string)			\
4838   do {							\
4839     (ptr) = SAFE_ALLOCA (SBYTES (string) + 1);		\
4840     memcpy (ptr, SDATA (string), SBYTES (string) + 1);	\
4841   } while (false)
4842 
4843 /* Free xmalloced memory and enable GC as needed.  */
4844 
4845 #define SAFE_FREE() safe_free (sa_count)
4846 
4847 INLINE void
safe_free(ptrdiff_t sa_count)4848 safe_free (ptrdiff_t sa_count)
4849 {
4850   while (specpdl_ptr != specpdl + sa_count)
4851     {
4852       specpdl_ptr--;
4853       if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR)
4854 	{
4855 	  eassert (specpdl_ptr->unwind_ptr.func == xfree);
4856 	  xfree (specpdl_ptr->unwind_ptr.arg);
4857 	}
4858       else
4859 	{
4860 	  eassert (specpdl_ptr->kind == SPECPDL_UNWIND_ARRAY);
4861 	  xfree (specpdl_ptr->unwind_array.array);
4862 	}
4863     }
4864 }
4865 
4866 /* Pop the specpdl stack back to COUNT, and return VAL.
4867    Prefer this to { SAFE_FREE (); unbind_to (COUNT, VAL); }
4868    when COUNT predates USE_SAFE_ALLOCA, as it is a bit more efficient
4869    and also lets callers intermix SAFE_ALLOCA calls with other calls
4870    that grow the specpdl stack.  */
4871 
4872 #define SAFE_FREE_UNBIND_TO(count, val) \
4873   safe_free_unbind_to (count, sa_count, val)
4874 
4875 INLINE Lisp_Object
safe_free_unbind_to(ptrdiff_t count,ptrdiff_t sa_count,Lisp_Object val)4876 safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val)
4877 {
4878   eassert (count <= sa_count);
4879   return unbind_to (count, val);
4880 }
4881 
4882 /* Set BUF to point to an allocated array of NELT Lisp_Objects,
4883    immediately followed by EXTRA spare bytes.  */
4884 
4885 #define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra)	       \
4886   do {							       \
4887     ptrdiff_t alloca_nbytes;				       \
4888     if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes)   \
4889 	|| INT_ADD_WRAPV (alloca_nbytes, extra, &alloca_nbytes) \
4890 	|| SIZE_MAX < alloca_nbytes)			       \
4891       memory_full (SIZE_MAX);				       \
4892     else if (alloca_nbytes <= sa_avail)			       \
4893       (buf) = AVAIL_ALLOCA (alloca_nbytes);		       \
4894     else						       \
4895       {							       \
4896 	(buf) = xmalloc (alloca_nbytes);		       \
4897 	record_unwind_protect_array (buf, nelt);	       \
4898       }							       \
4899   } while (false)
4900 
4901 /* Set BUF to point to an allocated array of NELT Lisp_Objects.  */
4902 
4903 #define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0)
4904 
4905 
4906 /* If USE_STACK_LISP_OBJECTS, define macros and functions that
4907    allocate some Lisp objects on the C stack.  As the storage is not
4908    managed by the garbage collector, these objects are dangerous:
4909    passing them to user code could result in undefined behavior if the
4910    objects are in use after the C function returns.  Conversely, these
4911    objects have better performance because GC is not involved.
4912 
4913    While debugging you may want to disable allocation on the C stack.
4914    Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it.  */
4915 
4916 #if (!defined USE_STACK_LISP_OBJECTS \
4917      && defined __GNUC__ && !defined __clang__ && ! GNUC_PREREQ (4, 3, 2))
4918   /* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2.  */
4919 # define USE_STACK_LISP_OBJECTS false
4920 #endif
4921 #ifndef USE_STACK_LISP_OBJECTS
4922 # define USE_STACK_LISP_OBJECTS true
4923 #endif
4924 
4925 #ifdef GC_CHECK_STRING_BYTES
4926 enum { defined_GC_CHECK_STRING_BYTES = true };
4927 #else
4928 enum { defined_GC_CHECK_STRING_BYTES = false };
4929 #endif
4930 
4931 /* True for stack-based cons and string implementations, respectively.
4932    Use stack-based strings only if stack-based cons also works.
4933    Otherwise, STACK_CONS would create heap-based cons cells that
4934    could point to stack-based strings, which is a no-no.  */
4935 
4936 enum
4937   {
4938     USE_STACK_CONS = USE_STACK_LISP_OBJECTS,
4939     USE_STACK_STRING = (USE_STACK_CONS
4940 			&& !defined_GC_CHECK_STRING_BYTES)
4941   };
4942 
4943 /* Auxiliary macros used for auto allocation of Lisp objects.  Please
4944    use these only in macros like AUTO_CONS that declare a local
4945    variable whose lifetime will be clear to the programmer.  */
4946 #define STACK_CONS(a, b) \
4947   make_lisp_ptr (&((struct Lisp_Cons) {{{a, {b}}}}), Lisp_Cons)
4948 #define AUTO_CONS_EXPR(a, b) \
4949   (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
4950 
4951 /* Declare NAME as an auto Lisp cons or short list if possible, a
4952    GC-based one otherwise.  This is in the sense of the C keyword
4953    'auto'; i.e., the object has the lifetime of the containing block.
4954    The resulting object should not be made visible to user Lisp code.  */
4955 
4956 #define AUTO_CONS(name, a, b) Lisp_Object name = AUTO_CONS_EXPR (a, b)
4957 #define AUTO_LIST1(name, a)						\
4958   Lisp_Object name = (USE_STACK_CONS ? STACK_CONS (a, Qnil) : list1 (a))
4959 #define AUTO_LIST2(name, a, b)						\
4960   Lisp_Object name = (USE_STACK_CONS					\
4961 		      ? STACK_CONS (a, STACK_CONS (b, Qnil))		\
4962 		      : list2 (a, b))
4963 #define AUTO_LIST3(name, a, b, c)					\
4964   Lisp_Object name = (USE_STACK_CONS					\
4965 		      ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c, Qnil))) \
4966 		      : list3 (a, b, c))
4967 #define AUTO_LIST4(name, a, b, c, d)					\
4968     Lisp_Object name							\
4969       = (USE_STACK_CONS							\
4970 	 ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c,			\
4971 						     STACK_CONS (d, Qnil)))) \
4972 	 : list4 (a, b, c, d))
4973 
4974 /* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
4975    Take its unibyte value from the NUL-terminated string STR,
4976    an expression that should not have side effects.
4977    STR's value is not necessarily copied.  The resulting Lisp string
4978    should not be modified or given text properties or made visible to
4979    user code.  */
4980 
4981 #define AUTO_STRING(name, str) \
4982   AUTO_STRING_WITH_LEN (name, str, strlen (str))
4983 
4984 /* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
4985    Take its unibyte value from the NUL-terminated string STR with length LEN.
4986    STR may have side effects and may contain NUL bytes.
4987    STR's value is not necessarily copied.  The resulting Lisp string
4988    should not be modified or given text properties or made visible to
4989    user code.  */
4990 
4991 #define AUTO_STRING_WITH_LEN(name, str, len)				\
4992   Lisp_Object name =							\
4993     (USE_STACK_STRING							\
4994      ? (make_lisp_ptr							\
4995 	((&(struct Lisp_String) {{{len, -1, 0, (unsigned char *) (str)}}}), \
4996 	 Lisp_String))							\
4997      : make_unibyte_string (str, len))
4998 
4999 /* The maximum length of "small" lists, as a heuristic.  These lists
5000    are so short that code need not check for cycles or quits while
5001    traversing.  */
5002 enum { SMALL_LIST_LEN_MAX = 127 };
5003 
5004 /* Loop over conses of the list TAIL, signaling if a cycle is found,
5005    and possibly quitting after each loop iteration.  In the loop body,
5006    set TAIL to the current cons.  If the loop exits normally,
5007    set TAIL to the terminating non-cons, typically nil.  The loop body
5008    should not modify the list’s top level structure other than by
5009    perhaps deleting the current cons.  */
5010 
5011 #define FOR_EACH_TAIL(tail) \
5012   FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
5013 
5014 /* Like FOR_EACH_TAIL (TAIL), except do not signal or quit.
5015    If the loop exits due to a cycle, TAIL’s value is undefined.  */
5016 
5017 #define FOR_EACH_TAIL_SAFE(tail) \
5018   FOR_EACH_TAIL_INTERNAL (tail, (void) ((tail) = Qnil), false)
5019 
5020 /* Iterator intended for use only within FOR_EACH_TAIL_INTERNAL.  */
5021 struct for_each_tail_internal
5022 {
5023   Lisp_Object tortoise;
5024   intptr_t max, n;
5025   unsigned short int q;
5026 };
5027 
5028 /* Like FOR_EACH_TAIL (LIST), except evaluate CYCLE if a cycle is
5029    found, and check for quit if CHECK_QUIT.  This is an internal macro
5030    intended for use only by the above macros.
5031 
5032    Use Brent’s teleporting tortoise-hare algorithm.  See:
5033    Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190
5034    https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf
5035 
5036    This macro uses maybe_quit because of an excess of caution.  The
5037    call to maybe_quit should not be needed in practice, as a very long
5038    list, whether circular or not, will cause Emacs to be so slow in
5039    other uninterruptible areas (e.g., garbage collection) that there
5040    is little point to calling maybe_quit here.  */
5041 
5042 #define FOR_EACH_TAIL_INTERNAL(tail, cycle, check_quit)			\
5043   for (struct for_each_tail_internal li = { tail, 2, 0, 2 };		\
5044        CONSP (tail);							\
5045        ((tail) = XCDR (tail),						\
5046 	((--li.q != 0							\
5047 	  || ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n)	\
5048 	  || (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH,		\
5049 	      li.tortoise = (tail), false))				\
5050 	 && EQ (tail, li.tortoise))					\
5051 	? (cycle) : (void) 0))
5052 
5053 /* Do a `for' loop over alist values.  */
5054 
5055 #define FOR_EACH_ALIST_VALUE(head_var, list_var, value_var)		\
5056   for ((list_var) = (head_var);						\
5057        (CONSP (list_var) && ((value_var) = XCDR (XCAR (list_var)), true)); \
5058        (list_var) = XCDR (list_var))
5059 
5060 /* Check whether it's time for GC, and run it if so.  */
5061 
5062 INLINE void
maybe_gc(void)5063 maybe_gc (void)
5064 {
5065   if (consing_until_gc < 0)
5066     maybe_garbage_collect ();
5067 }
5068 
5069 INLINE_HEADER_END
5070 
5071 #endif /* EMACS_LISP_H */
5072