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