Mercurial > hg > xemacs-beta

comparison src/lisp.h @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents 8eaf7971accc
children a2f645c6b9f8
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
165 #endif 165 #endif
166 #if !defined (ENCAPSULATE_FCLOSE) && defined (DONT_ENCAPSULATE) 166 #if !defined (ENCAPSULATE_FCLOSE) && defined (DONT_ENCAPSULATE)
167 # define sys_fclose fclose 167 # define sys_fclose fclose
168 #endif 168 #endif
169 169
170 /* Memory allocation */
171 void malloc_warning (CONST char *);
172 void *xmalloc (size_t size);
173 void *xmalloc_and_zero (size_t size);
174 void *xrealloc (void *, size_t size);
175 char *xstrdup (CONST char *);
170 /* generally useful */ 176 /* generally useful */
171 #define countof(x) (sizeof(x)/sizeof(x[0])) 177 #define countof(x) (sizeof(x)/sizeof(x[0]))
172 #define slot_offset(type, slot_name) \ 178 #define slot_offset(type, slot_name) \
173 ((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0))) 179 ((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0)))
174 #define malloc_type(type) ((type *) xmalloc (sizeof (type))) 180 #define xnew(type) ((type *) xmalloc (sizeof (type)))
175 #define malloc_type_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type))) 181 #define xnew_array(type, len) ((type *) xmalloc ((len) * sizeof (type)))
182 #define xnew_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type)))
183 #define xnew_array_and_zero(type, len) ((type *) xmalloc_and_zero ((len) * sizeof (type)))
184 #define XREALLOC_ARRAY(ptr, type, len) ((void) (ptr = (type *) xrealloc (ptr, (len) * sizeof (type))))
185 #define alloca_array(type, len) ((type *) alloca ((len) * sizeof (type)))
176 186
177 /* also generally useful if you want to avoid arbitrary size limits 187 /* also generally useful if you want to avoid arbitrary size limits
178 but don't need a full dynamic array. Assumes that BASEVAR points 188 but don't need a full dynamic array. Assumes that BASEVAR points
179 to a malloced array of TYPE objects (or possibly a NULL pointer, 189 to a malloced array of TYPE objects (or possibly a NULL pointer,
180 if SIZEVAR is 0), with the total size stored in SIZEVAR. This 190 if SIZEVAR is 0), with the total size stored in SIZEVAR. This
181 macro will realloc BASEVAR as necessary so that it can hold at 191 macro will realloc BASEVAR as necessary so that it can hold at
182 least NEEDED_SIZE objects. The reallocing is done by doubling, 192 least NEEDED_SIZE objects. The reallocing is done by doubling,
183 which ensures constant amortized time per element. */ 193 which ensures constant amortized time per element. */
184 #define DO_REALLOC(basevar, sizevar, needed_size, type) do \ 194 #define DO_REALLOC(basevar, sizevar, needed_size, type) do \
185 { \ 195 { \
186 /* Avoid side-effectualness. */ \ 196 /* Avoid side-effectualness. */ \
187 /* Dammit! Macros suffer from dynamic scope! */ \ 197 /* Dammit! Macros suffer from dynamic scope! */ \
188 /* We demand inline functions! */ \ 198 /* We demand inline functions! */ \
189 int do_realloc_needed_size = (needed_size); \ 199 int do_realloc_needed_size = (needed_size); \
190 int newsize = 0; \ 200 int newsize = 0; \
191 while ((sizevar) < (do_realloc_needed_size)) { \ 201 while ((sizevar) < (do_realloc_needed_size)) { \
192 newsize = 2*(sizevar); \ 202 newsize = 2*(sizevar); \
193 if (newsize < 32) \ 203 if (newsize < 32) \
194 newsize = 32; \ 204 newsize = 32; \
195 (sizevar) = newsize; \ 205 (sizevar) = newsize; \
196 } \ 206 } \
197 if (newsize) \ 207 if (newsize) \
198 (basevar) = (type *) xrealloc (basevar, \ 208 XREALLOC_ARRAY (basevar, type, newsize); \
199 (newsize)*sizeof(type)); \
200 } while (0) 209 } while (0)
201 210
202 #ifdef ERROR_CHECK_MALLOC 211 #ifdef ERROR_CHECK_MALLOC
203 #define xfree(lvalue) do \ 212 void xfree_1 (void *);
204 { \ 213 #define xfree(lvalue) do \
205 void **ptr = (void **) &(lvalue); \ 214 { \
206 xfree_1 (*ptr); \ 215 void **ptr = (void **) &(lvalue); \
207 *ptr = (void *) 0xDEADBEEF; \ 216 xfree_1 (*ptr); \
217 *ptr = (void *) 0xDEADBEEF; \
208 } while (0) 218 } while (0)
209 #else 219 #else
220 void xfree (void *);
210 #define xfree_1 xfree 221 #define xfree_1 xfree
211 #endif 222 #endif /* ERROR_CHECK_MALLOC */
212 223
213 /* We assume an ANSI C compiler and libraries and memcpy, memset, memcmp */ 224 /* We assume an ANSI C compiler and libraries and memcpy, memset, memcmp */
214 /* (This definition is here because system header file macros may want 225 /* (This definition is here because system header file macros may want
215 * to call bzero (eg FD_ZERO) */ 226 * to call bzero (eg FD_ZERO) */
216 #ifndef bzero 227 #ifndef bzero
429 typedef int Extcount; 440 typedef int Extcount;
430 441
431 typedef struct lstream Lstream; 442 typedef struct lstream Lstream;
432 443
433 typedef unsigned int face_index; 444 typedef unsigned int face_index;
434 typedef struct face_cachel_dynarr_type 445
446 typedef struct
435 { 447 {
436 Dynarr_declare (struct face_cachel); 448 Dynarr_declare (struct face_cachel);
437 } face_cachel_dynarr; 449 } face_cachel_dynarr;
438 450
439 typedef unsigned int glyph_index; 451 typedef unsigned int glyph_index;
440 typedef struct glyph_cachel_dynarr_type 452
453 typedef struct
441 { 454 {
442 Dynarr_declare (struct glyph_cachel); 455 Dynarr_declare (struct glyph_cachel);
443 } glyph_cachel_dynarr; 456 } glyph_cachel_dynarr;
444 457
445 struct buffer; /* "buffer.h" */ 458 struct buffer; /* "buffer.h" */
446 struct console; /* "console.h" */ 459 struct console; /* "console.h" */
447 struct device; /* "device.h" */ 460 struct device; /* "device.h" */
448 struct extent_fragment; 461 struct extent_fragment;
449 struct extent; 462 struct extent;
463 typedef struct extent *EXTENT;
450 struct frame; /* "frame.h" */ 464 struct frame; /* "frame.h" */
451 struct window; /* "window.h" */ 465 struct window; /* "window.h" */
452 struct Lisp_Event; /* "events.h" */ 466 struct Lisp_Event; /* "events.h" */
453 struct Lisp_Face; 467 struct Lisp_Face;
454 struct Lisp_Process; /* "process.c" */ 468 struct Lisp_Process; /* "process.c" */
462 struct scrollbar_instance; 476 struct scrollbar_instance;
463 struct font_metric_info; 477 struct font_metric_info;
464 struct face_cachel; 478 struct face_cachel;
465 struct console_type_entry; 479 struct console_type_entry;
466 480
467 typedef struct bufbyte_dynarr_type 481 typedef struct
468 { 482 {
469 Dynarr_declare (Bufbyte); 483 Dynarr_declare (Bufbyte);
470 } bufbyte_dynarr; 484 } Bufbyte_dynarr;
471 485
472 typedef struct extbyte_dynarr_type 486 typedef struct
473 { 487 {
474 Dynarr_declare (Extbyte); 488 Dynarr_declare (Extbyte);
475 } extbyte_dynarr; 489 } Extbyte_dynarr;
476 490
477 typedef struct emchar_dynarr_type 491 typedef struct
478 { 492 {
479 Dynarr_declare (Emchar); 493 Dynarr_declare (Emchar);
480 } emchar_dynarr; 494 } Emchar_dynarr;
481 495
482 typedef struct unsigned_char_dynarr_type 496 typedef unsigned char unsigned_char;
497 typedef struct
483 { 498 {
484 Dynarr_declare (unsigned char); 499 Dynarr_declare (unsigned char);
485 } unsigned_char_dynarr; 500 } unsigned_char_dynarr;
486 501
487 typedef struct int_dynarr_type 502 typedef struct
488 { 503 {
489 Dynarr_declare (int); 504 Dynarr_declare (int);
490 } int_dynarr; 505 } int_dynarr;
491 506
492 typedef struct bufpos_dynarr_type 507 typedef struct
493 { 508 {
494 Dynarr_declare (Bufpos); 509 Dynarr_declare (Bufpos);
495 } bufpos_dynarr; 510 } Bufpos_dynarr;
496 511
497 typedef struct bytind_dynarr_type 512 typedef struct
498 { 513 {
499 Dynarr_declare (Bytind); 514 Dynarr_declare (Bytind);
500 } bytind_dynarr; 515 } Bytind_dynarr;
501 516
502 typedef struct charcount_dynarr_type 517 typedef struct
503 { 518 {
504 Dynarr_declare (Charcount); 519 Dynarr_declare (Charcount);
505 } charcount_dynarr; 520 } Charcount_dynarr;
506 521
507 typedef struct bytecount_dynarr_type 522 typedef struct
508 { 523 {
509 Dynarr_declare (Bytecount); 524 Dynarr_declare (Bytecount);
510 } bytecount_dynarr; 525 } Bytecount_dynarr;
511 526
512 typedef struct console_type_entry_dynarr_type 527 typedef struct
513 { 528 {
514 Dynarr_declare (struct console_type_entry); 529 Dynarr_declare (struct console_type_entry);
515 } console_type_entry_dynarr; 530 } console_type_entry_dynarr;
516 531
517 /* Need to declare this here. */ 532 /* Need to declare this here. */
625 /* This is the set of Lisp data types */ 640 /* This is the set of Lisp data types */
626 641
627 enum Lisp_Type 642 enum Lisp_Type
628 { 643 {
629 /* Integer. XINT(obj) is the integer value. */ 644 /* Integer. XINT(obj) is the integer value. */
630 Lisp_Int /* 0 DTP-FIXNUM */ 645 Lisp_Type_Int, /* 0 DTP-FIXNUM */
631 646
632 /* XRECORD_LHEADER (object) points to a struct lrecord_header 647 /* XRECORD_LHEADER (object) points to a struct lrecord_header
633 lheader->implementation determines the type (and GC behaviour) 648 lheader->implementation determines the type (and GC behaviour)
634 of the object. */ 649 of the object. */
635 ,Lisp_Record /* 1 DTP-OTHER-POINTER */ 650 Lisp_Type_Record, /* 1 DTP-OTHER-POINTER */
636 651
637 /* Cons. XCONS (object) points to a struct Lisp_Cons. */ 652 /* Cons. XCONS (object) points to a struct Lisp_Cons. */
638 ,Lisp_Cons /* 2 DTP-LIST */ 653 Lisp_Type_Cons, /* 2 DTP-LIST */
639 654
640 /* LRECORD_STRING is NYI */ 655 /* LRECORD_STRING is NYI */
641 /* String. XSTRING (object) points to a struct Lisp_String. 656 /* String. XSTRING (object) points to a struct Lisp_String.
642 The length of the string, and its contents, are stored therein. */ 657 The length of the string, and its contents, are stored therein. */
643 ,Lisp_String /* 3 DTP-STRING */ 658 Lisp_Type_String, /* 3 DTP-STRING */
644 659
645 #ifndef LRECORD_VECTOR 660 #ifndef LRECORD_VECTOR
646 /* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector. 661 /* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector.
647 The length of the vector, and its contents, are stored therein. */ 662 The length of the vector, and its contents, are stored therein. */
648 ,Lisp_Vector /* 4 DTP-SIMPLE-ARRAY */ 663 Lisp_Type_Vector, /* 4 DTP-SIMPLE-ARRAY */
649 #endif 664 #endif /* !LRECORD_VECTOR */
650 665
651 #ifndef LRECORD_SYMBOL 666 #ifndef LRECORD_SYMBOL
652 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ 667 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
653 ,Lisp_Symbol 668 Lisp_Type_Symbol,
654 #endif /* !LRECORD_SYMBOL */ 669 #endif /* !LRECORD_SYMBOL */
655 670
656 ,Lisp_Char /* 5 DTP-CHAR */ 671 Lisp_Type_Char /* 5 DTP-CHAR */
657 }; 672 };
658 673
659 /* unsafe! */ 674 /* unsafe! */
660 #define POINTER_TYPE_P(type) ((type) != Lisp_Int && (type) != Lisp_Char) 675 #define POINTER_TYPE_P(type) ((type) != Lisp_Type_Int && (type) != Lisp_Type_Char)
661 676
662 /* This should be the underlying type into which a Lisp_Object must fit. 677 /* This should be the underlying type into which a Lisp_Object must fit.
663 In a strict ANSI world, this must be `int', since ANSI says you can't 678 In a strict ANSI world, this must be `int', since ANSI says you can't
664 use bitfields on any type other than `int'. However, on a machine 679 use bitfields on any type other than `int'. However, on a machine
665 where `int' and `long' are not the same size, this should be the 680 where `int' and `long' are not the same size, this should be the
694 # include "lisp-union.h" 709 # include "lisp-union.h"
695 #endif /* !NO_UNION_TYPE */ 710 #endif /* !NO_UNION_TYPE */
696 711
697 /* WARNING WARNING WARNING. You must ensure on your own that proper 712 /* WARNING WARNING WARNING. You must ensure on your own that proper
698 GC protection is provided for the elements in this array. */ 713 GC protection is provided for the elements in this array. */
699 typedef struct lisp_dynarr_type 714 typedef struct
700 { 715 {
701 Dynarr_declare (Lisp_Object); 716 Dynarr_declare (Lisp_Object);
702 } lisp_dynarr; 717 } Lisp_Object_dynarr;
703 718
704 /* Close your eyes now lest you vomit or spontaneously combust ... */ 719 /* Close your eyes now lest you vomit or spontaneously combust ... */
705 720
706 #define HACKEQ_UNSAFE(obj1, obj2) \ 721 #define HACKEQ_UNSAFE(obj1, obj2) \
707 (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \ 722 (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \
755 struct buffer *buffer; 770 struct buffer *buffer;
756 int bufpos; 771 int bufpos;
757 }; 772 };
758 #endif 773 #endif
759 774
760 DECLARE_NONRECORD (cons, Lisp_Cons, struct Lisp_Cons); 775 DECLARE_NONRECORD (cons, Lisp_Type_Cons, struct Lisp_Cons);
761 #define XCONS(a) XNONRECORD (a, cons, Lisp_Cons, struct Lisp_Cons) 776 #define XCONS(a) XNONRECORD (a, cons, Lisp_Type_Cons, struct Lisp_Cons)
762 #define XSETCONS(c, p) XSETOBJ (c, Lisp_Cons, p) 777 #define XSETCONS(c, p) XSETOBJ (c, Lisp_Type_Cons, p)
763 #define CONSP(x) (XTYPE (x) == Lisp_Cons) 778 #define CONSP(x) (XTYPE (x) == Lisp_Type_Cons)
764 #define GC_CONSP(x) (XGCTYPE (x) == Lisp_Cons) 779 #define GC_CONSP(x) (XGCTYPE (x) == Lisp_Type_Cons)
765 #define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Cons, Qconsp) 780 #define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp)
766 #define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Cons, Qconsp) 781 #define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp)
767 782
768 /* Define these because they're used in a few places, inside and 783 /* Define these because they're used in a few places, inside and
769 out of alloc.c */ 784 out of alloc.c */
770 #define CONS_MARKED_P(c) XMARKBIT (c->car) 785 #define CONS_MARKED_P(c) XMARKBIT (c->car)
771 #define MARK_CONS(c) XMARK (c->car) 786 #define MARK_CONS(c) XMARK (c->car)
841 #define STRINGP(x) RECORDP (x, string) 856 #define STRINGP(x) RECORDP (x, string)
842 #define GC_STRINGP(x) GC_RECORDP (x, string) 857 #define GC_STRINGP(x) GC_RECORDP (x, string)
843 #define CHECK_STRING(x) CHECK_RECORD (x, string) 858 #define CHECK_STRING(x) CHECK_RECORD (x, string)
844 #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string) 859 #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string)
845 860
846 #else 861 #else /* ! LRECORD_STRING */
847 862
848 DECLARE_NONRECORD (string, Lisp_String, struct Lisp_String); 863 DECLARE_NONRECORD (string, Lisp_Type_String, struct Lisp_String);
849 #define XSTRING(x) XNONRECORD (x, string, Lisp_String, struct Lisp_String) 864 #define XSTRING(x) XNONRECORD (x, string, Lisp_Type_String, struct Lisp_String)
850 #define XSETSTRING(x, p) XSETOBJ (x, Lisp_String, p) 865 #define XSETSTRING(x, p) XSETOBJ (x, Lisp_Type_String, p)
851 #define STRINGP(x) (XTYPE (x) == Lisp_String) 866 #define STRINGP(x) (XTYPE (x) == Lisp_Type_String)
852 #define GC_STRINGP(x) (XGCTYPE (x) == Lisp_String) 867 #define GC_STRINGP(x) (XGCTYPE (x) == Lisp_Type_String)
853 #define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_String, Qstringp) 868 #define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_Type_String, Qstringp)
854 #define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_String, Qstringp) 869 #define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_Type_String, Qstringp)
855 870
856 #endif 871 #endif /* ! LRECORD_STRING */
857 872
858 #ifdef MULE 873 #ifdef MULE
859 874
860 Charcount bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len); 875 Charcount bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len);
861 Bytecount charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len); 876 Bytecount charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len);
872 #define string_data(s) ((s)->_data + 0) 887 #define string_data(s) ((s)->_data + 0)
873 #define XSTRING_DATA(s) string_data (XSTRING (s)) 888 #define XSTRING_DATA(s) string_data (XSTRING (s))
874 #define string_byte(s, i) ((s)->_data[i] + 0) 889 #define string_byte(s, i) ((s)->_data[i] + 0)
875 #define XSTRING_BYTE(s, i) string_byte (XSTRING (s), i) 890 #define XSTRING_BYTE(s, i) string_byte (XSTRING (s), i)
876 #define string_byte_addr(s, i) (&((s)->_data[i])) 891 #define string_byte_addr(s, i) (&((s)->_data[i]))
877 #define set_string_length(s, len) do { (s)->_size = (len); } while (0) 892 #define set_string_length(s, len) ((void) ((s)->_size = (len)))
878 #define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0) 893 #define set_string_data(s, ptr) ((void) ((s)->_data = (ptr)))
879 #define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0) 894 #define set_string_byte(s, i, c) ((void) ((s)->_data[i] = (c)))
880 895
881 void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta); 896 void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta);
882 897
883 #ifdef MULE 898 #ifdef MULE
884 899
926 #define CHECK_VECTOR(x) CHECK_RECORD (x, vector) 941 #define CHECK_VECTOR(x) CHECK_RECORD (x, vector)
927 #define CONCHECK_VECTOR(x) CONCHECK_RECORD (x, vector) 942 #define CONCHECK_VECTOR(x) CONCHECK_RECORD (x, vector)
928 943
929 #else 944 #else
930 945
931 DECLARE_NONRECORD (vector, Lisp_Vector, struct Lisp_Vector); 946 DECLARE_NONRECORD (vector, Lisp_Type_Vector, struct Lisp_Vector);
932 #define XVECTOR(x) XNONRECORD (x, vector, Lisp_Vector, struct Lisp_Vector) 947 #define XVECTOR(x) XNONRECORD (x, vector, Lisp_Type_Vector, struct Lisp_Vector)
933 #define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Vector, p) 948 #define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Type_Vector, p)
934 #define VECTORP(x) (XTYPE (x) == Lisp_Vector) 949 #define VECTORP(x) (XTYPE (x) == Lisp_Type_Vector)
935 #define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Vector) 950 #define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Type_Vector)
936 #define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Vector, Qvectorp) 951 #define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp)
937 #define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Vector, Qvectorp) 952 #define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp)
938 953
939 #endif 954 #endif
940 955
941 #define vector_length(v) ((v)->size) 956 #define vector_length(v) ((v)->size)
942 #define XVECTOR_LENGTH(s) vector_length (XVECTOR (s)) 957 #define XVECTOR_LENGTH(s) vector_length (XVECTOR (s))
1045 #define CHECK_SYMBOL(x) CHECK_RECORD (x, symbol) 1060 #define CHECK_SYMBOL(x) CHECK_RECORD (x, symbol)
1046 #define CONCHECK_SYMBOL(x) CONCHECK_RECORD (x, symbol) 1061 #define CONCHECK_SYMBOL(x) CONCHECK_RECORD (x, symbol)
1047 1062
1048 #else 1063 #else
1049 1064
1050 DECLARE_NONRECORD (symbol, Lisp_Symbol, struct Lisp_Symbol); 1065 DECLARE_NONRECORD (symbol, Lisp_Type_Symbol, struct Lisp_Symbol);
1051 #define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Symbol, struct Lisp_Symbol) 1066 #define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Type_Symbol, struct Lisp_Symbol)
1052 #define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Symbol, (p)) 1067 #define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Type_Symbol, (p))
1053 #define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) 1068 #define SYMBOLP(x) (XTYPE (x) == Lisp_Type_Symbol)
1054 #define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Symbol) 1069 #define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Type_Symbol)
1055 #define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp) 1070 #define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp)
1056 #define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp) 1071 #define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp)
1057 1072
1058 #endif 1073 #endif
1059 1074
1060 #define symbol_next(s) ((s)->next) 1075 #define symbol_next(s) ((s)->next)
1061 #define symbol_name(s) ((s)->name) 1076 #define symbol_name(s) ((s)->name)
1113 #define marker_next(m) ((m)->next) 1128 #define marker_next(m) ((m)->next)
1114 #define marker_prev(m) ((m)->prev) 1129 #define marker_prev(m) ((m)->prev)
1115 1130
1116 /*********** char ***********/ 1131 /*********** char ***********/
1117 1132
1118 #define CHARP(x) (XTYPE (x) == Lisp_Char) 1133 #define CHARP(x) (XTYPE (x) == Lisp_Type_Char)
1119 #define GC_CHARP(x) (XGCTYPE (x) == Lisp_Char) 1134 #define GC_CHARP(x) (XGCTYPE (x) == Lisp_Type_Char)
1120 1135
1121 #ifdef ERROR_CHECK_TYPECHECK 1136 #ifdef ERROR_CHECK_TYPECHECK
1122 1137
1123 INLINE Emchar XCHAR (Lisp_Object obj); 1138 INLINE Emchar XCHAR (Lisp_Object obj);
1124 INLINE Emchar 1139 INLINE Emchar
1132 1147
1133 #define XCHAR(x) XREALINT (x) 1148 #define XCHAR(x) XREALINT (x)
1134 1149
1135 #endif 1150 #endif
1136 1151
1137 #define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Char, Qcharacterp) 1152 #define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp)
1138 #define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Char, Qcharacterp) 1153 #define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp)
1139 1154
1140 1155
1141 /*********** float ***********/ 1156 /*********** float ***********/
1142 1157
1143 #ifdef LISP_FLOAT_TYPE 1158 #ifdef LISP_FLOAT_TYPE
1169 x = wrong_type_argument (Qnumberp, (x)); } while (0) 1184 x = wrong_type_argument (Qnumberp, (x)); } while (0)
1170 1185
1171 /* These are always continuable because they change their arguments 1186 /* These are always continuable because they change their arguments
1172 even when no error is signalled. */ 1187 even when no error is signalled. */
1173 1188
1174 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ 1189 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \
1175 { if (INTP (x) || FLOATP (x)) \ 1190 { if (INTP (x) || FLOATP (x)) \
1176 ; \ 1191 ; \
1177 else if (MARKERP (x)) \ 1192 else if (MARKERP (x)) \
1178 x = make_int (marker_position (x)); \ 1193 x = make_int (marker_position (x)); \
1179 else \ 1194 else \
1180 x = wrong_type_argument (Qnumber_or_marker_p, x); \ 1195 x = wrong_type_argument (Qnumber_or_marker_p, x); \
1181 } while (0) 1196 } while (0)
1182 1197
1183 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ 1198 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \
1184 { if (INTP (x) || FLOATP (x)) \ 1199 { if (INTP (x) || FLOATP (x)) \
1185 ; \ 1200 ; \
1186 else if (CHARP (x)) \ 1201 else if (CHARP (x)) \
1187 x = make_int (XCHAR (x)); \ 1202 x = make_int (XCHAR (x)); \
1188 else if (MARKERP (x)) \ 1203 else if (MARKERP (x)) \
1189 x = make_int (marker_position (x)); \ 1204 x = make_int (marker_position (x)); \
1190 else \ 1205 else \
1191 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ 1206 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
1192 } while (0) 1207 } while (0)
1193 1208
1194 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) 1209 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
1195 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x)) 1210 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x))
1196 1211
1212 #define INT_OR_FLOATP(x) (INTP (x)) 1227 #define INT_OR_FLOATP(x) (INTP (x))
1213 # define GC_INT_OR_FLOATP(x) (GC_INTP (x)) 1228 # define GC_INT_OR_FLOATP(x) (GC_INTP (x))
1214 1229
1215 #endif /* not LISP_FLOAT_TYPE */ 1230 #endif /* not LISP_FLOAT_TYPE */
1216 1231
1217 #define INTP(x) (XTYPE (x) == Lisp_Int) 1232 #define INTP(x) (XTYPE (x) == Lisp_Type_Int)
1218 #define GC_INTP(x) (XGCTYPE (x) == Lisp_Int) 1233 #define GC_INTP(x) (XGCTYPE (x) == Lisp_Type_Int)
1219 1234
1220 #define ZEROP(x) EQ (x, Qzero) 1235 #define ZEROP(x) EQ (x, Qzero)
1221 #define GC_ZEROP(x) GC_EQ (x, Qzero) 1236 #define GC_ZEROP(x) GC_EQ (x, Qzero)
1222 1237
1223 #ifdef ERROR_CHECK_TYPECHECK 1238 #ifdef ERROR_CHECK_TYPECHECK
1234 1249
1235 #define XINT(obj) XREALINT (obj) 1250 #define XINT(obj) XREALINT (obj)
1236 1251
1237 #endif 1252 #endif
1238 1253
1239 #define CHECK_INT(x) CHECK_NONRECORD (x, Lisp_Int, Qintegerp) 1254 #define CHECK_INT(x) CHECK_NONRECORD (x, Lisp_Type_Int, Qintegerp)
1240 #define CONCHECK_INT(x) CONCHECK_NONRECORD (x, Lisp_Int, Qintegerp) 1255 #define CONCHECK_INT(x) CONCHECK_NONRECORD (x, Lisp_Type_Int, Qintegerp)
1241 1256
1242 #define NATNUMP(x) (INTP (x) && XINT (x) >= 0) 1257 #define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
1243 #define GC_NATNUMP(x) (GC_INTP (x) && XINT (x) >= 0) 1258 #define GC_NATNUMP(x) (GC_INTP (x) && XINT (x) >= 0)
1244 1259
1245 #define CHECK_NATNUM(x) \ 1260 #define CHECK_NATNUM(x) \
1246 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0) 1261 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0)
1247 #define CONCHECK_NATNUM(x) \ 1262 #define CONCHECK_NATNUM(x) \
1248 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) 1263 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
1249 1264
1250 /* next three always continuable because they coerce their arguments. */ 1265 /* next three always continuable because they coerce their arguments. */
1251 #define CHECK_INT_COERCE_CHAR(x) do \ 1266 #define CHECK_INT_COERCE_CHAR(x) do \
1252 { if (INTP (x)) \ 1267 { if (INTP (x)) \
1253 ; \ 1268 ; \
1254 else if (CHARP (x)) \ 1269 else if (CHARP (x)) \
1255 x = make_int (XCHAR (x)); \ 1270 x = make_int (XCHAR (x)); \
1256 else \ 1271 else \
1257 x = wrong_type_argument (Qinteger_or_char_p, x); \ 1272 x = wrong_type_argument (Qinteger_or_char_p, x); \
1258 } while (0) 1273 } while (0)
1259 1274
1260 #define CHECK_INT_COERCE_MARKER(x) do \ 1275 #define CHECK_INT_COERCE_MARKER(x) do \
1261 { if (INTP (x)) \ 1276 { if (INTP (x)) \
1262 ; \ 1277 ; \
1263 else if (MARKERP (x)) \ 1278 else if (MARKERP (x)) \
1264 x = make_int (marker_position (x)); \ 1279 x = make_int (marker_position (x)); \
1265 else \ 1280 else \
1266 x = wrong_type_argument (Qinteger_or_marker_p, x); \ 1281 x = wrong_type_argument (Qinteger_or_marker_p, x); \
1267 } while (0) 1282 } while (0)
1268 1283
1269 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ 1284 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \
1270 { if (INTP (x)) \ 1285 { if (INTP (x)) \
1271 ; \ 1286 ; \
1272 else if (CHARP (x)) \ 1287 else if (CHARP (x)) \
1273 x = make_int (XCHAR (x)); \ 1288 x = make_int (XCHAR (x)); \
1274 else if (MARKERP (x)) \ 1289 else if (MARKERP (x)) \
1275 x = make_int (marker_position (x)); \ 1290 x = make_int (marker_position (x)); \
1276 else \ 1291 else \
1277 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ 1292 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
1278 } while (0) 1293 } while (0)
1279 1294
1280 /*********** pure space ***********/ 1295 /*********** pure space ***********/
1281 1296
1282 #define CHECK_IMPURE(obj) \ 1297 #define CHECK_IMPURE(obj) \
1283 do { if (purified (obj)) pure_write_error (); } while (0) 1298 do { if (purified (obj)) pure_write_error (); } while (0)
1284 1299
1285 /*********** structures ***********/ 1300 /*********** structures ***********/
1286 1301
1302 typedef struct structure_keyword_entry structure_keyword_entry;
1287 struct structure_keyword_entry 1303 struct structure_keyword_entry
1288 { 1304 {
1289 Lisp_Object keyword; 1305 Lisp_Object keyword;
1290 int (*validate) (Lisp_Object keyword, Lisp_Object value, 1306 int (*validate) (Lisp_Object keyword, Lisp_Object value,
1291 Error_behavior errb); 1307 Error_behavior errb);
1292 }; 1308 };
1293 1309
1294 typedef struct structure_keyword_entry_dynarr_type 1310 typedef struct
1295 { 1311 {
1296 Dynarr_declare (struct structure_keyword_entry); 1312 Dynarr_declare (structure_keyword_entry);
1297 } Structure_keyword_entry_dynarr; 1313 } structure_keyword_entry_dynarr;
1298 1314
1315 typedef struct structure_type structure_type;
1299 struct structure_type 1316 struct structure_type
1300 { 1317 {
1301 Lisp_Object type; 1318 Lisp_Object type;
1302 Structure_keyword_entry_dynarr *keywords; 1319 structure_keyword_entry_dynarr *keywords;
1303 int (*validate) (Lisp_Object data, Error_behavior errb); 1320 int (*validate) (Lisp_Object data, Error_behavior errb);
1304 Lisp_Object (*instantiate) (Lisp_Object data); 1321 Lisp_Object (*instantiate) (Lisp_Object data);
1305 }; 1322 };
1306 1323
1307 typedef struct structure_type_dynarr_type 1324 typedef struct
1308 { 1325 {
1309 Dynarr_declare (struct structure_type); 1326 Dynarr_declare (structure_type);
1310 } Structure_type_dynarr; 1327 } structure_type_dynarr;
1311 1328
1312 struct structure_type *define_structure_type (Lisp_Object type, 1329 struct structure_type *define_structure_type (Lisp_Object type,
1313 int (*validate) 1330 int (*validate)
1314 (Lisp_Object data, 1331 (Lisp_Object data,
1315 Error_behavior errb), 1332 Error_behavior errb),
1757 #define RETURN__ return 1774 #define RETURN__ return
1758 #define RETURN_NOT_REACHED(value) return value; 1775 #define RETURN_NOT_REACHED(value) return value;
1759 #endif 1776 #endif
1760 1777
1761 /* Evaluate expr, UNGCPRO, and then return the value of expr. */ 1778 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
1762 #define RETURN_UNGCPRO(expr) do \ 1779 #define RETURN_UNGCPRO(expr) do \
1763 { \ 1780 { \
1764 Lisp_Object ret_ungc_val = (expr); \ 1781 Lisp_Object ret_ungc_val = (expr); \
1765 UNGCPRO; \ 1782 UNGCPRO; \
1766 RETURN__ ret_ungc_val; \ 1783 RETURN__ ret_ungc_val; \
1767 } while (0) 1784 } while (0)
1768 1785
1769 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ 1786 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
1770 #define RETURN_NUNGCPRO(expr) do \ 1787 #define RETURN_NUNGCPRO(expr) do \
1771 { \ 1788 { \
1772 Lisp_Object ret_ungc_val = (expr); \ 1789 Lisp_Object ret_ungc_val = (expr); \
1773 NUNGCPRO; \ 1790 NUNGCPRO; \
1774 UNGCPRO; \ 1791 UNGCPRO; \
1775 RETURN__ ret_ungc_val; \ 1792 RETURN__ ret_ungc_val; \
1776 } while (0) 1793 } while (0)
1777 1794
1778 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the 1795 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
1779 value of expr. */ 1796 value of expr. */
1780 #define RETURN_NNUNGCPRO(expr) do \ 1797 #define RETURN_NNUNGCPRO(expr) do \
1781 { \ 1798 { \
1782 Lisp_Object ret_ungc_val = (expr); \ 1799 Lisp_Object ret_ungc_val = (expr); \
1783 NNUNGCPRO; \ 1800 NNUNGCPRO; \
1784 NUNGCPRO; \ 1801 NUNGCPRO; \
1785 UNGCPRO; \ 1802 UNGCPRO; \
1786 RETURN__ ret_ungc_val; \ 1803 RETURN__ ret_ungc_val; \
1787 } while (0) 1804 } while (0)
1788 1805
1789 /* Evaluate expr, return it if it's not Qunbound. */ 1806 /* Evaluate expr, return it if it's not Qunbound. */
1790 #define RETURN_IF_NOT_UNBOUND(expr) do \ 1807 #define RETURN_IF_NOT_UNBOUND(expr) do \
1791 { \ 1808 { \
1792 Lisp_Object ret_nunb_val = (expr); \ 1809 Lisp_Object ret_nunb_val = (expr); \
1793 if (!UNBOUNDP (ret_nunb_val)) \ 1810 if (!UNBOUNDP (ret_nunb_val)) \
1794 RETURN__ ret_nunb_val; \ 1811 RETURN__ ret_nunb_val; \
1795 } while (0) 1812 } while (0)
1796 1813
1797 /* Call staticpro (&var) to protect static variable `var'. */ 1814 /* Call staticpro (&var) to protect static variable `var'. */
1798 void staticpro (Lisp_Object *); 1815 void staticpro (Lisp_Object *);
1799 1816