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