mirrored from git://git.sv.gnu.org/emacs.git
-
Notifications
You must be signed in to change notification settings - Fork 1.3k
/
Copy pathlisp.h
5871 lines (5026 loc) · 186 KB
/
lisp.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*-
Copyright (C) 1985-2025 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
#include <alloca.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdbit.h>
#include <stdckdint.h>
#include <stddef.h>
#include <string.h>
#include <float.h>
#include <inttypes.h>
#include <limits.h>
#include <stdio.h>
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#include <attribute.h>
#include <byteswap.h>
#include <intprops.h>
#include <verify.h>
INLINE_HEADER_BEGIN
/* Define a TYPE constant ID as an externally visible name. Use like this:
DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
# define ID (some integer preprocessor expression of type TYPE)
DEFINE_GDB_SYMBOL_END (ID)
This hack is for the benefit of compilers that do not make macro
definitions or enums visible to the debugger. It's used for symbols
that .gdbinit needs. */
#define DECLARE_GDB_SYM(type, id) type const id EXTERNALLY_VISIBLE
#ifdef MAIN_PROGRAM
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) \
extern DECLARE_GDB_SYM (type, id); DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(val) ;
#endif
/* The ubiquitous max and min macros. */
#undef min
#undef max
#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))
/* Number of elements in an array. */
#define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0])
/* Number of bits in a Lisp_Object tag. */
DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
#define GCTYPEBITS 3
DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
/* EMACS_INT - signed integer wide enough to hold an Emacs value
EMACS_INT_WIDTH - width in bits of EMACS_INT
EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
pI - printf length modifier for EMACS_INT
EMACS_UINT - unsigned variant of EMACS_INT */
#ifndef EMACS_INT_MAX
# if INTPTR_MAX <= 0
# error "INTPTR_MAX misconfigured"
# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
typedef int EMACS_INT;
typedef unsigned int EMACS_UINT;
enum { EMACS_INT_WIDTH = INT_WIDTH, EMACS_UINT_WIDTH = UINT_WIDTH };
# define EMACS_INT_MAX INT_MAX
# define pI ""
# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
typedef long int EMACS_INT;
typedef unsigned long EMACS_UINT;
enum { EMACS_INT_WIDTH = LONG_WIDTH, EMACS_UINT_WIDTH = ULONG_WIDTH };
# define EMACS_INT_MAX LONG_MAX
# define pI "l"
# elif INTPTR_MAX <= LLONG_MAX
typedef long long int EMACS_INT;
typedef unsigned long long int EMACS_UINT;
enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH };
# define EMACS_INT_MAX LLONG_MAX
/* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero,
which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or
later and the runtime version is 5.0.0 or later. Otherwise,
printf-like functions are declared with __ms_printf__ attribute,
which will cause a warning for %lld etc. */
# if defined __MINGW32__ \
&& (!defined __USE_MINGW_ANSI_STDIO \
|| (!defined MINGW_W64 \
&& !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)))
# define pI "I64"
# else /* ! MinGW */
# define pI "ll"
# endif
# else
# error "INTPTR_MAX too large"
# endif
#endif
/* Number of bits to put in each character in the internal representation
of bool vectors. This should not vary across implementations. */
enum { BOOL_VECTOR_BITS_PER_CHAR =
#define BOOL_VECTOR_BITS_PER_CHAR 8
BOOL_VECTOR_BITS_PER_CHAR
};
/* An unsigned integer type representing a fixed-length bit sequence,
suitable for bool vector words, GC mark bits, etc. Normally it is size_t
for speed, but on weird platforms it is unsigned char and not all
its bits are used. */
#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
typedef size_t bits_word;
# define BITS_WORD_MAX SIZE_MAX
enum { BITS_PER_BITS_WORD = SIZE_WIDTH };
#else
typedef unsigned char bits_word;
# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
#endif
static_assert (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
/* Use pD to format ptrdiff_t values, which suffice for indexes into
buffers and strings. Emacs never allocates objects larger than
PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
In C99, pD can always be "t", as we no longer need to worry about
pre-C99 libraries such as glibc 2.0 (1997) and Solaris 8 (2000). */
#define pD "t"
/* Convenience macro for rarely-used functions that do not return. */
#define AVOID _Noreturn ATTRIBUTE_COLD void
/* Extra internal type checking? */
/* Define Emacs versions of <assert.h>'s 'assert (COND)' and <verify.h>'s
'assume (COND)'. COND should be free of side effects, as it may or
may not be evaluated.
'eassert (COND)' checks COND at runtime if ENABLE_CHECKING is
defined and suppress_checking is false, and does nothing otherwise.
Emacs dies if COND is checked and is false. The suppress_checking
variable is initialized to 0 in alloc.c. Set it to 1 using a
debugger to temporarily disable aborting on detected internal
inconsistencies or error conditions.
In some cases, a good compiler may be able to optimize away the
eassert macro even if ENABLE_CHECKING is true, e.g., if XSTRING (x)
uses eassert to test STRINGP (x), but a particular use of XSTRING
is invoked only after testing that STRINGP (x) is true, making the
test redundant.
eassume is like eassert except that it also causes the compiler to
assume that COND is true afterwards, regardless of whether runtime
checking is enabled. This can improve performance in some cases,
though it can degrade performance in others. It's often suboptimal
for COND to call external functions or access volatile storage. */
#ifndef ENABLE_CHECKING
# define eassert(cond) ((void) (false && (cond))) /* Check COND compiles. */
# define eassume(cond) assume (cond)
#else /* ENABLE_CHECKING */
extern AVOID die (const char *, const char *, int);
extern bool suppress_checking EXTERNALLY_VISIBLE;
# define eassert(cond) \
(suppress_checking || (cond) \
? (void) 0 \
: die (# cond, __FILE__, __LINE__))
# define eassume(cond) \
(suppress_checking \
? assume (cond) \
: (cond) \
? (void) 0 \
: die (# cond, __FILE__, __LINE__))
#endif /* ENABLE_CHECKING */
/* Use the configure flag --enable-check-lisp-object-type to make
Lisp_Object use a struct type instead of the default int. The flag
causes CHECK_LISP_OBJECT_TYPE to be defined. */
/***** Select the tagging scheme. *****/
/* The following option controls the tagging scheme:
- USE_LSB_TAG means that we can assume the least 3 bits of pointers are
always 0, and we can thus use them to hold tag bits, without
restricting our addressing space.
If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
restricting our possible address range.
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
on some non-GC Lisp_Objects, all of which are aligned via
GCALIGNED_UNION_MEMBER. */
enum Lisp_Bits
{
/* Number of bits in a Lisp_Object value, not counting the tag. */
VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
/* Number of bits in a fixnum value, not counting the tag. */
FIXNUM_BITS = VALBITS + 1
};
/* Number of bits in a fixnum tag; can be used in #if. */
DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS)
#define INTTYPEBITS (GCTYPEBITS - 1)
DEFINE_GDB_SYMBOL_END (INTTYPEBITS)
/* The maximum value that can be stored in a EMACS_INT, assuming all
bits other than the type bits contribute to a nonnegative signed value.
This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an
expression involving VAL_MAX. */
#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
/* Whether the least-significant bits of an EMACS_INT contain the tag.
On hosts where pointers-as-ints do not exceed VAL_MAX / 2, USE_LSB_TAG is:
a. unnecessary, because the top bits of an EMACS_INT are unused, and
b. slower, because it typically requires extra masking.
So, USE_LSB_TAG is true only on hosts where it might be useful. */
DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
#define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
/* Mask for the value (as opposed to the type bits) of a Lisp object. */
DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
DEFINE_GDB_SYMBOL_END (VALMASK)
/* Ignore 'alignas' on compilers lacking it. */
#if (!defined alignas && !defined __alignas_is_defined \
&& __STDC_VERSION__ < 202311 && __cplusplus < 201103)
# define alignas(a)
#endif
/* The minimum alignment requirement for Lisp objects that is imposed by the
internal representation of tagged pointers. It is 2**GCTYPEBITS if
USE_LSB_TAG, 1 otherwise. It must be a literal integer constant,
for older versions of GCC (through at least 4.9). */
#if USE_LSB_TAG
# define GCALIGNMENT 8
# if GCALIGNMENT != 1 << GCTYPEBITS
# error "GCALIGNMENT and GCTYPEBITS are inconsistent"
# endif
#else
# define GCALIGNMENT 1
#endif
/* To cause a union to have alignment of at least GCALIGNMENT, put
GCALIGNED_UNION_MEMBER in its member list.
If a struct is always GC-aligned (either by the GC, or via
allocation in a containing union that has GCALIGNED_UNION_MEMBER)
and does not contain a GC-aligned struct or union, putting
GCALIGNED_STRUCT after its closing '}' can help the compiler
generate better code. Also, such structs should be added to the
emacs_align_type union in alloc.c.
Although these macros are reasonably portable, they are not
guaranteed on non-GCC platforms, as the C standard does not require
support for alignment to GCALIGNMENT and older compilers may ignore
alignment requests. For any type T where garbage collection requires
alignment, use static_assert (GCALIGNED (T)) to verify the
requirement on the current platform. Types need this check if their
objects can be allocated outside the garbage collector. For example,
struct Lisp_Symbol needs the check because of lispsym and struct
Lisp_Cons needs it because of STACK_CONS. */
#define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned;
#if HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED_STRUCT
#endif
#define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0)
/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
integer. Usually it is a pointer to a deliberately-incomplete type
'struct Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
pointers differ in width. */
#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
#if LISP_WORDS_ARE_POINTERS
/* TAG_PTR_INITIALLY casts to Lisp_Word and can be used in static initializers
so this typedef assumes static initializers can contain casts to pointers.
All Emacs targets support this extension to the C standard. */
typedef struct Lisp_X *Lisp_Word;
#else
typedef EMACS_INT Lisp_Word;
#endif
/* Some operations are so commonly executed that they are implemented
as macros, not functions, because otherwise runtime performance would
suffer too much when compiling with GCC without optimization.
There's no need to inline everything, just the operations that
would otherwise cause a serious performance problem.
For each such operation OP, define a macro lisp_h_OP that contains
the operation's implementation. That way, OP can be implemented
via a macro definition like this:
#define OP(x) lisp_h_OP (x)
and/or via a function definition like this:
Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); }
without worrying about the implementations diverging, since
lisp_h_OP defines the actual implementation. The lisp_h_OP macros
are intended to be private to this include file, and should not be
used elsewhere. They should evaluate each argument exactly once,
so that they behave like their functional counterparts.
FIXME: Remove the lisp_h_OP macros, and define just the inline OP
functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well
enough for Emacs developers. Maybe in the year 2025. See Bug#11935.
For the macros that have corresponding functions (defined later),
see these functions for commentary. */
/* Convert among the various Lisp-related types: I for EMACS_INT, L
for Lisp_Object, P for void *.
These use the following mnemonics:
XLI: Lisp_Object to Integer;
XIL: Integer to Lisp_Object;
XLP: Lisp_Object to Pointer. */
#if !CHECK_LISP_OBJECT_TYPE
# if LISP_WORDS_ARE_POINTERS
# define lisp_h_XLI(o) ((EMACS_INT) (o))
# define lisp_h_XIL(i) ((Lisp_Object) (i))
# define lisp_h_XLP(o) ((void *) (o))
# else
# define lisp_h_XLI(o) (o)
# define lisp_h_XIL(i) (i)
# define lisp_h_XLP(o) ((void *) (uintptr_t) (o))
# endif
# define lisp_h_Qnil 0
#else
# if LISP_WORDS_ARE_POINTERS
# define lisp_h_XLI(o) ((EMACS_INT) (o).i)
# define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)})
# define lisp_h_XLP(o) ((void *) (o).i)
# else
# define lisp_h_XLI(o) ((o).i)
# define lisp_h_XIL(i) ((Lisp_Object) {i})
# define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i)
# endif
# define lisp_h_Qnil {0}
#endif
#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
((ok) ? (void) 0 : wrong_type_argument (predicate, x))
#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y))
#define lisp_h_FIXNUMP(x) \
(! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
- (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \
& ((1 << INTTYPEBITS) - 1)))
#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
#define lisp_h_NILP(x) BASE_EQ (x, Qnil)
#define lisp_h_SYMBOL_CONSTANT_P(sym) \
(XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS)
#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol)
#define lisp_h_TAGGEDP(a, tag) \
(! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
- (unsigned) (tag)) \
& ((1 << GCTYPEBITS) - 1)))
#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
#define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
#if USE_LSB_TAG
# define lisp_h_make_fixnum_wrap(n) \
XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
# if defined HAVE_STATEMENT_EXPRESSIONS && defined HAVE_TYPEOF
# define lisp_h_make_fixnum(n) \
({ typeof (+(n)) lisp_h_make_fixnum_n = n; \
eassert (!FIXNUM_OVERFLOW_P (lisp_h_make_fixnum_n)); \
lisp_h_make_fixnum_wrap (lisp_h_make_fixnum_n); })
# else
# define lisp_h_make_fixnum(n) lisp_h_make_fixnum_wrap (n)
# endif
# define lisp_h_XFIXNUM_RAW(a) (XLI (a) >> INTTYPEBITS)
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
#endif
/* When DEFINE_KEY_OPS_AS_MACROS, define key operations as macros to
cajole the compiler into inlining them; otherwise define them as
inline functions as this is cleaner and can be more efficient.
The default is true if the compiler is GCC-like and if function
inlining is disabled because the compiler is not optimizing or is
optimizing for size. Otherwise the default is false. */
#ifndef DEFINE_KEY_OPS_AS_MACROS
# if (defined __NO_INLINE__ \
&& ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__)
# define DEFINE_KEY_OPS_AS_MACROS true
# else
# define DEFINE_KEY_OPS_AS_MACROS false
# endif
#endif
#if DEFINE_KEY_OPS_AS_MACROS
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
# define XLP(o) lisp_h_XLP (o)
# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x)
# define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
# define CONSP(x) lisp_h_CONSP (x)
# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y)
# define FLOATP(x) lisp_h_FLOATP (x)
# define FIXNUMP(x) lisp_h_FIXNUMP (x)
# define NILP(x) lisp_h_NILP (x)
# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
# define XCAR(c) lisp_h_XCAR (c)
# define XCDR(c) lisp_h_XCDR (c)
# define XHASH(a) lisp_h_XHASH (a)
# if USE_LSB_TAG
# define make_fixnum(n) lisp_h_make_fixnum (n)
# define XFIXNUM_RAW(a) lisp_h_XFIXNUM_RAW (a)
# define XTYPE(a) lisp_h_XTYPE (a)
# endif
#endif
/* Define the fundamental Lisp data structures. */
/* This is the set of Lisp data types. If you want to define a new
data type, read the comments after Lisp_Fwd_Type definition
below. */
/* Fixnums use 2 tags, to give them one extra bit, thus
extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
/* Idea stolen from GDB. Pedantic GCC complains about enum bitfields,
and xlc and Oracle Studio c99 complain vociferously about them. */
#if (defined __STRICT_ANSI__ || defined __IBMC__ \
|| (defined __SUNPRO_C && __STDC__))
#define ENUM_BF(TYPE) unsigned int
#else
#define ENUM_BF(TYPE) enum TYPE
#endif
/* Lisp_Object tagging scheme:
Tag location
Upper bits Lower bits Type Payload
000....... .......000 symbol offset from lispsym to struct Lisp_Symbol
001....... .......001 unused
01........ ........10 fixnum signed integer of FIXNUM_BITS
110....... .......011 cons pointer to struct Lisp_Cons
100....... .......100 string pointer to struct Lisp_String
101....... .......101 vectorlike pointer to union vectorlike_header
111....... .......111 float pointer to struct Lisp_Float */
enum Lisp_Type
{
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
Lisp_Symbol = 0,
/* Type 1 is currently unused. */
Lisp_Type_Unused0 = 1,
/* Fixnum. XFIXNUM (obj) is the integer value. */
Lisp_Int0 = 2,
Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
Lisp_String = 4,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
the size and contents. The size field also contains the type
information, if it's not a real vector object. */
Lisp_Vectorlike = 5,
/* Cons. XCONS (object) points to a struct Lisp_Cons. */
Lisp_Cons = USE_LSB_TAG ? 3 : 6,
/* Must be last entry in Lisp_Type enumeration. */
Lisp_Float = 7
};
/* These are the types of forwarding objects used in the value slot
of symbols for special built-in variables whose value is stored in
C variables. */
enum Lisp_Fwd_Type
{
Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
Lisp_Fwd_Kboard_Obj /* Fwd to a Lisp_Object field of kboards. */
};
/* If you want to define a new Lisp data type, here are some
instructions.
First, there are already a couple of Lisp types that can be used if
your new type does not need to be exposed to Lisp programs nor
displayed to users. These are Lisp_Misc_Ptr and PVEC_OTHER,
which are both vectorlike objects. The former
is suitable for stashing a pointer in a Lisp object; the pointer
might be to some low-level C object that contains auxiliary
information. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
These two types don't look pretty when printed, so they are
unsuitable for Lisp objects that can be exposed to users.
To define a new data type, add a pseudovector subtype by extending
the pvec_type enumeration. A pseudovector provides one or more
slots for Lisp objects, followed by struct members that are
accessible only from C.
There is no way to explicitly free a Lisp Object; only the garbage
collector frees them.
For a new pseudovector, it's highly desirable to limit the size
of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c).
Otherwise you will need to change sweep_vectors (also in alloc.c).
Then you will need to add switch branches in print.c (in
print_object, to print your object, and possibly also in
print_preprocess) and to alloc.c, to mark your object (in
mark_object) and to free it (in gc_sweep). The latter is also the
right place to call any code specific to your data type that needs
to run when the object is recycled -- e.g., free any additional
resources allocated for it that are not Lisp objects. You can even
make a pointer to the function that frees the resources a slot in
your object -- this way, the same object could be used to represent
several disparate C structures.
In addition, you need to add switch branches in data.c for Fcl_type_of
and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */
/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a
Lisp_Word. However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper
around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'.
LISP_INITIALLY (W) initializes a Lisp object with a tagged value
that is a Lisp_Word W. It can be used in a static initializer. */
#ifdef CHECK_LISP_OBJECT_TYPE
typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
# define LISP_OBJECT_IS_STRUCT
# define LISP_INITIALLY(w) {w}
# undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
#else
typedef Lisp_Word Lisp_Object;
# define LISP_INITIALLY(w) (w)
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
#endif
/* Forward declarations. */
/* Defined in this file. */
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
/* Defined in bignum.c. */
extern int check_int_nonnegative (Lisp_Object);
extern intmax_t check_integer_range (Lisp_Object, intmax_t, intmax_t);
extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
extern Lisp_Object make_bigint (intmax_t);
extern Lisp_Object make_biguint (uintmax_t);
extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t);
/* Defined in chartab.c. */
extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE;
extern void char_table_set (Lisp_Object, int, Lisp_Object);
/* Defined in data.c. */
extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object default_value (Lisp_Object symbol);
extern void defalias (Lisp_Object symbol, Lisp_Object definition);
extern char *fixnum_to_string (EMACS_INT number, char *buffer, char *end);
/* Defined in emacs.c. */
/* Set after Emacs has started up the first time.
Prevents reinitialization of the Lisp world and keymaps on
subsequent starts. */
extern bool initialized;
extern struct gflags
{
/* True means this Emacs instance was born to dump. */
bool will_dump_ : 1;
bool will_bootstrap_ : 1;
#ifdef HAVE_PDUMPER
/* Set in an Emacs process that will likely dump with pdumper; all
Emacs processes may dump with pdumper, however. */
bool will_dump_with_pdumper_ : 1;
/* Set in an Emacs process that has been restored from a portable
dump. */
bool dumped_with_pdumper_ : 1;
#endif
} gflags;
INLINE bool
will_dump_p (void)
{
#if HAVE_PDUMPER
return gflags.will_dump_;
#else
return false;
#endif
}
INLINE bool
will_bootstrap_p (void)
{
#if HAVE_PDUMPER
return gflags.will_bootstrap_;
#else
return false;
#endif
}
INLINE bool
will_dump_with_pdumper_p (void)
{
#if HAVE_PDUMPER
return gflags.will_dump_with_pdumper_;
#else
return false;
#endif
}
INLINE bool
dumped_with_pdumper_p (void)
{
#if HAVE_PDUMPER
return gflags.dumped_with_pdumper_;
#else
return false;
#endif
}
/* Defined in floatfns.c. */
extern double extract_float (Lisp_Object);
/* Low-level conversion and type checking. */
/* Convert among various types use to implement Lisp_Object. At the
machine level, these operations may widen or narrow their arguments
if pointers differ in width from EMACS_INT; otherwise they are
no-ops. */
INLINE EMACS_INT
(XLI) (Lisp_Object o)
{
return lisp_h_XLI (o);
}
INLINE Lisp_Object
(XIL) (EMACS_INT i)
{
return lisp_h_XIL (i);
}
INLINE void *
(XLP) (Lisp_Object o)
{
return lisp_h_XLP (o);
}
/* Extract A's type. */
INLINE enum Lisp_Type
(XTYPE) (Lisp_Object a)
{
#if USE_LSB_TAG
return lisp_h_XTYPE (a);
#else
EMACS_UINT i = XLI (a);
return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
#endif
}
/* True if A has type tag TAG.
Equivalent to XTYPE (a) == TAG, but often faster. */
INLINE bool
(TAGGEDP) (Lisp_Object a, enum Lisp_Type tag)
{
return lisp_h_TAGGEDP (a, tag);
}
INLINE void
(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x)
{
lisp_h_CHECK_TYPE (ok, predicate, x);
}
/* Extract A's pointer value, assuming A's Lisp type is TYPE and the
extracted pointer's type is CTYPE *. When !USE_LSB_TAG this simply
extracts A's low-order bits, as (uintptr_t) LISP_WORD_TAG (type) is
always zero then. */
#define XUNTAG(a, type, ctype) \
((ctype *) ((uintptr_t) XLP (a) - (uintptr_t) LISP_WORD_TAG (type)))
/* A forwarding pointer to a value. It uses a generic pointer to
avoid alignment bugs that could occur if it used a pointer to a
union of the possible values (struct Lisp_Objfwd, struct
Lisp_Intfwd, etc.). The pointer is packaged inside a struct to
help static checking. */
typedef struct { void const *fwdptr; } lispfwd;
/* Interned state of a symbol. */
enum symbol_interned
{
SYMBOL_UNINTERNED, /* not interned anywhere */
SYMBOL_INTERNED, /* interned but not in initial obarray */
SYMBOL_INTERNED_IN_INITIAL_OBARRAY /* interned in initial obarray */
};
enum symbol_redirect
{
SYMBOL_PLAINVAL, /* plain var, value is in the `value' field */
SYMBOL_VARALIAS, /* var alias, value is really in the `alias' symbol */
SYMBOL_LOCALIZED, /* localized var, value is in the `blv' object */
SYMBOL_FORWARDED /* forwarding var, value is in `forward' */
};
enum symbol_trapped_write
{
SYMBOL_UNTRAPPED_WRITE, /* normal case, just set the value */
SYMBOL_NOWRITE, /* constant, cannot set, e.g. nil, t, :keyword */
SYMBOL_TRAPPED_WRITE /* trap the write, call watcher functions */
};
struct Lisp_Symbol
{
union
{
struct
{
bool_bf gcmarkbit : 1;
/* Indicates where the value can be found. */
ENUM_BF (symbol_redirect) redirect : 2;
ENUM_BF (symbol_trapped_write) trapped_write : 2;
/* Interned state of the symbol. */
ENUM_BF (symbol_interned) interned : 2;
/* True means that this variable has been explicitly declared
special (with `defvar' etc), and shouldn't be lexically bound. */
bool_bf declared_special : 1;
/* The symbol's name, as a Lisp string. */
Lisp_Object name;
/* Value of the symbol or Qunbound if unbound. Which alternative of the
union is used depends on the `redirect' field above. */
union {
Lisp_Object value;
struct Lisp_Symbol *alias;
struct Lisp_Buffer_Local_Value *blv;
lispfwd fwd;
} val;
/* Function value of the symbol or Qnil if not fboundp. */
Lisp_Object function;
/* The symbol's property list. */
Lisp_Object plist;
/* Next symbol in obarray bucket, if the symbol is interned. */
struct Lisp_Symbol *next;
} s;
GCALIGNED_UNION_MEMBER
} u;
};
static_assert (GCALIGNED (struct Lisp_Symbol));
/* Declare a Lisp-callable function. The MAXARGS parameter has the same
meaning as in the DEFUN macro, and is used to construct a prototype. */
/* We can use the same trick as in the DEFUN macro to generate the
appropriate prototype. */
#define EXFUN(fnname, maxargs) \
extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
/* Note that the weird token-substitution semantics of ANSI C makes
this work for MANY and UNEVALLED. */
#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
#define DEFUN_ARGS_0 (void)
#define DEFUN_ARGS_1 (Lisp_Object)
#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object)
#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* Lisp_Word_tag is big enough for a possibly-shifted tag, to be
added to a pointer value for conversion to a Lisp_Word. */
#if LISP_WORDS_ARE_POINTERS
typedef uintptr_t Lisp_Word_tag;
#else
typedef EMACS_UINT Lisp_Word_tag;
#endif
/* A integer value tagged with TAG, and otherwise all zero. */
#define LISP_WORD_TAG(tag) \
((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS))
/* An initializer for a Lisp_Object that contains TAG along with P.
P can be a pointer or an integer. The result is usable in a static
initializer if TAG and P are both integer constant expressions. */
#define TAG_PTR_INITIALLY(tag, p) \
LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (p) + LISP_WORD_TAG (tag)))
/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
designed for use as a (possibly static) initializer. */
#define LISPSYM_INITIALLY(name) \
TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym))
/* Declare extern constants for Lisp symbols. These can be helpful
when using a debugger like GDB, on older platforms where the debug
format does not represent C macros. However, they are unbounded
and would just be asking for trouble if checking pointer bounds. */
#define DEFINE_LISP_SYMBOL(name) \
DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
/* The index of the C-defined Lisp symbol SYM.
This can be used in a static initializer. */
#define SYMBOL_INDEX(sym) i##sym
/* By default, define macros for Qt, etc., as this leads to a bit
better performance in the core Emacs interpreter. A plugin can
define DEFINE_NON_NIL_Q_SYMBOL_MACROS to be false, to be portable to
other Emacs instances that assign different values to Qt, etc. */
#ifndef DEFINE_NON_NIL_Q_SYMBOL_MACROS
# define DEFINE_NON_NIL_Q_SYMBOL_MACROS true
#endif
/* True if N is a power of 2. N should be positive. */
#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0)
/* Return X rounded to the next multiple of Y. Y should be positive,
and Y - 1 + X should not overflow. Arguments should not have side
effects, as they are evaluated more than once. Tune for Y being a
power of 2. */
#define ROUNDUP(x, y) (POWER_OF_2 (y) \
? ((y) - 1 + (x)) & ~ ((y) - 1) \
: ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y))
#include <globals.h>
/* Header of vector-like objects. This documents the layout constraints on
vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
and PSEUDOVECTORP cast their pointers to union vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
incorrectly reorder loads and stores to their size fields. See
Bug#8546. This union formerly contained more members, and there's
no compelling reason to change it to a struct merely because the
number of members has been reduced to one. */
union vectorlike_header
{
/* The `size' header word, W bits wide, has one of two forms
discriminated by the second-highest bit (PSEUDOVECTOR_FLAG):
1 1 W-2
+---+---+-------------------------------------+
| M | 0 | SIZE | vector
+---+---+-------------------------------------+
1 1 W-32 6 12 12
+---+---+--------+------+----------+----------+
| M | 1 | unused | TYPE | RESTSIZE | LISPSIZE | pseudovector
+---+---+--------+------+----------+----------+
M (ARRAY_MARK_FLAG) holds the GC mark bit.
SIZE is the length (number of slots) of a regular Lisp vector,
and the object layout is struct Lisp_Vector.
TYPE is the pseudovector subtype (enum pvec_type).
LISPSIZE is the number of Lisp_Object fields at the beginning of the
object (after the header). These are always traced by the GC.
RESTSIZE is the number of fields (in word_size units) following.
These are not automatically traced by the GC.
For PVEC_BOOL and statically allocated PVEC_SUBR, RESTSIZE is 0.
(The block size for PVEC_BOOL is computed from its own size
field, to avoid being restricted by the 12-bit RESTSIZE field.)
*/
ptrdiff_t size;
};
struct Lisp_Symbol_With_Pos
{
union vectorlike_header header;
Lisp_Object sym; /* A symbol */
Lisp_Object pos; /* A fixnum */
} GCALIGNED_STRUCT;
/* In the size word of a vector, this bit means the vector has been marked. */
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
# define ARRAY_MARK_FLAG PTRDIFF_MIN
DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
/* In the size word of a struct Lisp_Vector, this bit means it's really
some other vector-like object. */
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
/* In a pseudovector, the size field actually contains a word with one
PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
with PVEC_TYPE_MASK to indicate the actual type. */
enum pvec_type
{
PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */
PVEC_FREE,
PVEC_BIGNUM,
PVEC_MARKER,
PVEC_OVERLAY,
PVEC_FINALIZER,
PVEC_SYMBOL_WITH_POS,
PVEC_MISC_PTR,
PVEC_USER_PTR,
PVEC_PROCESS,
PVEC_FRAME,
PVEC_WINDOW,
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
PVEC_OBARRAY,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
PVEC_OTHER, /* Should never be visible to Elisp code. */
PVEC_XWIDGET,
PVEC_XWIDGET_VIEW,
PVEC_THREAD,
PVEC_MUTEX,
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,