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