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