Mercurial > hg > xemacs-beta

comparison src/lisp.h @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents c0965ff3b039
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
167 to a malloced array of TYPE objects (or possibly a NULL pointer, 167 to a malloced array of TYPE objects (or possibly a NULL pointer,
168 if SIZEVAR is 0), with the total size stored in SIZEVAR. This 168 if SIZEVAR is 0), with the total size stored in SIZEVAR. This
169 macro will realloc BASEVAR as necessary so that it can hold at 169 macro will realloc BASEVAR as necessary so that it can hold at
170 least NEEDED_SIZE objects. The reallocing is done by doubling, 170 least NEEDED_SIZE objects. The reallocing is done by doubling,
171 which ensures constant amortized time per element. */ 171 which ensures constant amortized time per element. */
172 #define DO_REALLOC(basevar, sizevar, needed_size, type) do \ 172 #define DO_REALLOC(basevar, sizevar, needed_size, type) do \
173 { \ 173 { \
174 /* Avoid side-effectualness. */ \ 174 /* Avoid side-effectualness. */ \
175 /* Dammit! Macros suffer from dynamic scope! */ \ 175 /* Dammit! Macros suffer from dynamic scope! */ \
176 /* We demand inline functions! */ \ 176 /* We demand inline functions! */ \
177 int do_realloc_needed_size = (needed_size); \ 177 int do_realloc_needed_size = (needed_size); \
178 int newsize = 0; \ 178 int newsize = 0; \
179 while ((sizevar) < (do_realloc_needed_size)) { \ 179 while ((sizevar) < (do_realloc_needed_size)) { \
180 newsize = 2*(sizevar); \ 180 newsize = 2*(sizevar); \
181 if (newsize < 32) \ 181 if (newsize < 32) \
182 newsize = 32; \ 182 newsize = 32; \
183 (sizevar) = newsize; \ 183 (sizevar) = newsize; \
184 } \ 184 } \
185 if (newsize) \ 185 if (newsize) \
186 (basevar) = (type *) xrealloc (basevar, \ 186 (basevar) = (type *) xrealloc (basevar, \
187 (newsize)*sizeof(type)); \ 187 (newsize)*sizeof(type)); \
188 } while (0) 188 } while (0)
189 189
190 #ifdef ERROR_CHECK_MALLOC 190 #ifdef ERROR_CHECK_MALLOC
191 #define xfree(lvalue) do \ 191 #define xfree(lvalue) do \
192 { \ 192 { \
193 void **ptr = (void **) &(lvalue); \ 193 void **ptr = (void **) &(lvalue); \
194 xfree_1 (*ptr); \ 194 xfree_1 (*ptr); \
195 *ptr = (void *) 0xDEADBEEF; \ 195 *ptr = (void *) 0xDEADBEEF; \
196 } while (0) 196 } while (0)
197 #else 197 #else
198 #define xfree_1 xfree 198 #define xfree_1 xfree
199 #endif 199 #endif
200 200
249 249
250 #define ALIGN_SIZE(len, unit) \ 250 #define ALIGN_SIZE(len, unit) \
251 ((((len) + (unit) - 1) / (unit)) * (unit)) 251 ((((len) + (unit) - 1) / (unit)) * (unit))
252 252
253 /* #### Yuck, this is kind of evil */ 253 /* #### Yuck, this is kind of evil */
254 #define ALIGN_PTR(ptr, unit) \ 254 #define ALIGN_PTR(ptr, unit) ((void *) ALIGN_SIZE ((long) (ptr), unit))
255 ((void *) ALIGN_SIZE ((long) (ptr), unit))
256 255
257 #ifdef QUANTIFY 256 #ifdef QUANTIFY
258 #include "quantify.h" 257 #include "quantify.h"
259 #define QUANTIFY_START_RECORDING \ 258 #define QUANTIFY_START_RECORDING quantify_start_recording_data ()
260 do { quantify_start_recording_data (); } while (0) 259 #define QUANTIFY_STOP_RECORDING quantify_stop_recording_data ()
261 #define QUANTIFY_STOP_RECORDING \
262 do { quantify_stop_recording_data (); } while (0)
263 #else /* !QUANTIFY */ 260 #else /* !QUANTIFY */
264 #define QUANTIFY_START_RECORDING 261 #define QUANTIFY_START_RECORDING
265 #define QUANTIFY_STOP_RECORDING 262 #define QUANTIFY_STOP_RECORDING
266 #endif /* !QUANTIFY */ 263 #endif /* !QUANTIFY */
267 264
272 /* We define assert iff USE_ASSERTIONS or DEBUG_XEMACS is defined. 269 /* We define assert iff USE_ASSERTIONS or DEBUG_XEMACS is defined.
273 Otherwise we it to NULL. Quantify has shown that the time the 270 Otherwise we it to NULL. Quantify has shown that the time the
274 assert checks take is measurable so let's not include them in 271 assert checks take is measurable so let's not include them in
275 production binaries. */ 272 production binaries. */
276 273
277 #define abort() (assert_failed (__FILE__, __LINE__, "abort()"))
278
279 #ifdef USE_ASSERTIONS 274 #ifdef USE_ASSERTIONS
280 /* Highly dubious kludge */ 275 /* Highly dubious kludge */
281 /* (thanks, Jamie, I feel better now -- ben) */ 276 /* (thanks, Jamie, I feel better now -- ben) */
282 DECLARE_DOESNT_RETURN (assert_failed (CONST char *, int, CONST char *)); 277 DECLARE_DOESNT_RETURN (assert_failed (CONST char *, int, CONST char *));
278 # define abort() (assert_failed (__FILE__, __LINE__, "abort()"))
283 # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x)) 279 # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x))
284 #else 280 #else
285 # ifdef DEBUG_XEMACS 281 # ifdef DEBUG_XEMACS
286 # define assert(x) ((x) ? (void) 0 : (void) abort ()) 282 # define assert(x) ((x) ? (void) 0 : (void) abort ())
287 # else 283 # else
608 /************************************************************************/ 604 /************************************************************************/
609 605
610 /* There's not any particular reason not to use lrecords for these; some 606 /* There's not any particular reason not to use lrecords for these; some
611 objects get slightly larger, but we get 3 bit tags instead of 4. 607 objects get slightly larger, but we get 3 bit tags instead of 4.
612 */ 608 */
613 /* #define LRECORD_SYMBOL */ 609 #define LRECORD_SYMBOL
614 610
615 611
616 /* Define the fundamental Lisp data structures */ 612 /* Define the fundamental Lisp data structures */
617 613
618 /* This is the set of Lisp data types */ 614 /* This is the set of Lisp data types */
643 639
644 #ifndef LRECORD_SYMBOL 640 #ifndef LRECORD_SYMBOL
645 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ 641 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
646 ,Lisp_Symbol 642 ,Lisp_Symbol
647 #endif /* !LRECORD_SYMBOL */ 643 #endif /* !LRECORD_SYMBOL */
644
645 ,Lisp_Char /* 5 DTP-CHAR */
648 }; 646 };
649 647
650 /* unsafe! */ 648 /* unsafe! */
651 #define POINTER_TYPE_P(type) ((type) != Lisp_Int) 649 #define POINTER_TYPE_P(type) ((type) != Lisp_Int && (type) != Lisp_Char)
652 650
653 /* This should be the underlying type into which a Lisp_Object must fit. 651 /* This should be the underlying type into which a Lisp_Object must fit.
654 In a strict ANSI world, this must be `int', since ANSI says you can't 652 In a strict ANSI world, this must be `int', since ANSI says you can't
655 use bitfields on any type other than `int'. However, on a machine 653 use bitfields on any type other than `int'. However, on a machine
656 where `int' and `long' are not the same size, this should be the 654 where `int' and `long' are not the same size, this should be the
702 #define HACKEQ_UNSAFE(obj1, obj2) \ 700 #define HACKEQ_UNSAFE(obj1, obj2) \
703 (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \ 701 (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \
704 && !POINTER_TYPE_P (XGCTYPE (obj2)) \ 702 && !POINTER_TYPE_P (XGCTYPE (obj2)) \
705 && XREALINT (obj1) == XREALINT (obj2))) 703 && XREALINT (obj1) == XREALINT (obj2)))
706 704
707 INLINE int HACKEQ (Lisp_Object obj1, Lisp_Object obj2); 705 #ifdef DEBUG_XEMACS
708 INLINE int 706 extern int debug_issue_ebola_notices;
709 HACKEQ (Lisp_Object obj1, Lisp_Object obj2) 707 int eq_with_ebola_notice (Lisp_Object, Lisp_Object);
710 { 708 #define EQ_WITH_EBOLA_NOTICE(obj1, obj2) \
711 return HACKEQ_UNSAFE (obj1, obj2); 709 (debug_issue_ebola_notices ? eq_with_ebola_notice (obj1, obj2) \
712 } 710 : EQ (obj1, obj2))
711 #else
712 #define EQ_WITH_EBOLA_NOTICE(obj1, obj2) EQ (obj1, obj2)
713 #endif
713 714
714 /* OK, you can open them again */ 715 /* OK, you can open them again */
715 716
716 /************************************************************************/ 717 /************************************************************************/
717 /* Definitions of basic Lisp objects */ 718 /* Definitions of basic Lisp objects */
778 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar)) 779 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
779 780
780 /* For a list that's known to be in valid list format, where we may 781 /* For a list that's known to be in valid list format, where we may
781 be deleting the current element out of the list -- 782 be deleting the current element out of the list --
782 will abort() if the list is not in valid format */ 783 will abort() if the list is not in valid format */
783 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \ 784 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \
784 for (consvar = list; \ 785 for (consvar = list; \
785 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \ 786 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \
786 consvar = nextconsvar) 787 consvar = nextconsvar)
787 788
788 /* For a list that may not be in valid list format -- 789 /* For a list that may not be in valid list format --
789 will signal an error if the list is not in valid format */ 790 will signal an error if the list is not in valid format */
790 #define EXTERNAL_LIST_LOOP(consvar, listp) \ 791 #define EXTERNAL_LIST_LOOP(consvar, listp) \
846 #define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_String, Qstringp) 847 #define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_String, Qstringp)
847 #define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_String, Qstringp) 848 #define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_String, Qstringp)
848 849
849 #endif 850 #endif
850 851
852 #ifdef MULE
853
854 Charcount bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len);
855 Bytecount charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len);
856
857 #else /* not MULE */
851 858
852 # define bytecount_to_charcount(ptr, len) (len) 859 # define bytecount_to_charcount(ptr, len) (len)
853 # define charcount_to_bytecount(ptr, len) (len) 860 # define charcount_to_bytecount(ptr, len) (len)
861
862 #endif /* not MULE */
854 863
855 #define string_length(s) ((s)->_size) 864 #define string_length(s) ((s)->_size)
856 #define XSTRING_LENGTH(s) string_length (XSTRING (s)) 865 #define XSTRING_LENGTH(s) string_length (XSTRING (s))
857 #define string_data(s) ((s)->_data + 0) 866 #define string_data(s) ((s)->_data + 0)
858 #define XSTRING_DATA(s) string_data (XSTRING (s)) 867 #define XSTRING_DATA(s) string_data (XSTRING (s))
863 #define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0) 872 #define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0)
864 #define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0) 873 #define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0)
865 874
866 void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta); 875 void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta);
867 876
877 #ifdef MULE
878
879 INLINE Charcount string_char_length (struct Lisp_String *s);
880 INLINE Charcount
881 string_char_length (struct Lisp_String *s)
882 {
883 return bytecount_to_charcount (string_data (s), string_length (s));
884 }
885
886 # define string_char(s, i) charptr_emchar_n (string_data (s), i)
887 # define string_char_addr(s, i) charptr_n_addr (string_data (s), i)
888 void set_string_char (struct Lisp_String *s, Charcount i, Emchar c);
889
890 #else /* not MULE */
891
868 # define string_char_length(s) string_length (s) 892 # define string_char_length(s) string_length (s)
869 # define string_char(s, i) ((Emchar) string_byte (s, i)) 893 # define string_char(s, i) ((Emchar) string_byte (s, i))
870 # define string_char_addr(s, i) string_byte_addr (s, i) 894 # define string_char_addr(s, i) string_byte_addr (s, i)
871 # define set_string_char(s, i, c) set_string_byte (s, i, c) 895 # define set_string_char(s, i, c) set_string_byte (s, i, c)
872 896
897 #endif /* not MULE */
873 898
874 /*********** vector ***********/ 899 /*********** vector ***********/
875 900
876 struct Lisp_Vector 901 struct Lisp_Vector
877 { 902 {
1029 #define symbol_function(s) ((s)->function) 1054 #define symbol_function(s) ((s)->function)
1030 #define symbol_plist(s) ((s)->plist) 1055 #define symbol_plist(s) ((s)->plist)
1031 1056
1032 /*********** subr ***********/ 1057 /*********** subr ***********/
1033 1058
1034 typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...);
1035
1036 struct Lisp_Subr 1059 struct Lisp_Subr
1037 { 1060 {
1038 struct lrecord_header lheader; 1061 struct lrecord_header lheader;
1039 short min_args, max_args; 1062 short min_args, max_args;
1040 CONST char *prompt; 1063 CONST char *prompt;
1041 CONST char *doc; 1064 CONST char *doc;
1042 CONST char *name; 1065 CONST char *name;
1043 lisp_fn_t subr_fn; 1066 Lisp_Object (*subr_fn) ();
1044 }; 1067 };
1045 1068
1046 DECLARE_LRECORD (subr, struct Lisp_Subr); 1069 DECLARE_LRECORD (subr, struct Lisp_Subr);
1047 #define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr) 1070 #define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr)
1048 #define XSETSUBR(x, p) XSETRECORD (x, p, subr) 1071 #define XSETSUBR(x, p) XSETRECORD (x, p, subr)
1079 #define marker_next(m) ((m)->next) 1102 #define marker_next(m) ((m)->next)
1080 #define marker_prev(m) ((m)->prev) 1103 #define marker_prev(m) ((m)->prev)
1081 1104
1082 /*********** char ***********/ 1105 /*********** char ***********/
1083 1106
1084 #define CHARP(x) (INTP (x)) 1107 #define CHARP(x) (XTYPE (x) == Lisp_Char)
1085 #define GC_CHARP(x) (GC_INTP (x)) 1108 #define GC_CHARP(x) (XGCTYPE (x) == Lisp_Char)
1086 1109
1087 #ifdef ERROR_CHECK_TYPECHECK 1110 #ifdef ERROR_CHECK_TYPECHECK
1088 1111
1089 INLINE Emchar XCHAR (Lisp_Object obj); 1112 INLINE Emchar XCHAR (Lisp_Object obj);
1090 INLINE Emchar 1113 INLINE Emchar
1091 XCHAR (Lisp_Object obj) 1114 XCHAR (Lisp_Object obj)
1092 { 1115 {
1116 assert (CHARP (obj));
1093 return XREALINT (obj); 1117 return XREALINT (obj);
1094 } 1118 }
1095 1119
1096 #else 1120 #else
1097 1121
1098 #define XCHAR(x) (XINT (x)) 1122 #define XCHAR(x) XREALINT (x)
1099 1123
1100 #endif 1124 #endif
1101 1125
1102 #define CHECK_CHAR(x) (CHECK_INT (x)) 1126 #define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Char, Qcharacterp)
1103 #define CONCHECK_CHAR(x) (CONCHECK_INT (x)) 1127 #define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Char, Qcharacterp)
1104 1128
1105 1129
1106 /*********** float ***********/ 1130 /*********** float ***********/
1107 1131
1108 #ifdef LISP_FLOAT_TYPE 1132 #ifdef LISP_FLOAT_TYPE
1138 x = wrong_type_argument (Qnumberp, (x)); } while (0) 1162 x = wrong_type_argument (Qnumberp, (x)); } while (0)
1139 1163
1140 /* These are always continuable because they change their arguments 1164 /* These are always continuable because they change their arguments
1141 even when no error is signalled. */ 1165 even when no error is signalled. */
1142 1166
1143 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ 1167 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \
1144 { if (INTP (x) || FLOATP (x)) \ 1168 { if (INTP (x) || FLOATP (x)) \
1145 ; \ 1169 ; \
1146 else if (MARKERP (x)) \ 1170 else if (MARKERP (x)) \
1147 x = make_int (marker_position (x)); \ 1171 x = make_int (marker_position (x)); \
1148 else \ 1172 else \
1149 x = wrong_type_argument (Qnumber_or_marker_p, x); \ 1173 x = wrong_type_argument (Qnumber_or_marker_p, x); \
1150 } while (0) 1174 } while (0)
1151 1175
1152 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ 1176 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \
1153 { if (INTP (x) || FLOATP (x)) \ 1177 { if (INTP (x) || FLOATP (x)) \
1154 ; \ 1178 ; \
1155 else if (CHARP (x)) \ 1179 else if (CHARP (x)) \
1156 x = make_int (XCHAR (x)); \ 1180 x = make_int (XCHAR (x)); \
1157 else if (MARKERP (x)) \ 1181 else if (MARKERP (x)) \
1158 x = make_int (marker_position (x)); \ 1182 x = make_int (marker_position (x)); \
1159 else \ 1183 else \
1160 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ 1184 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
1161 } while (0) 1185 } while (0)
1162 1186
1163 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) 1187 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
1164 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x)) 1188 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x))
1165 1189
1215 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0) 1239 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0)
1216 #define CONCHECK_NATNUM(x) \ 1240 #define CONCHECK_NATNUM(x) \
1217 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) 1241 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
1218 1242
1219 /* next three always continuable because they coerce their arguments. */ 1243 /* next three always continuable because they coerce their arguments. */
1220 #define CHECK_INT_COERCE_CHAR(x) do \ 1244 #define CHECK_INT_COERCE_CHAR(x) do \
1221 { if (INTP (x)) \ 1245 { if (INTP (x)) \
1222 ; \ 1246 ; \
1223 else if (CHARP (x)) \ 1247 else if (CHARP (x)) \
1224 x = make_int (XCHAR (x)); \ 1248 x = make_int (XCHAR (x)); \
1225 else \ 1249 else \
1226 x = wrong_type_argument (Qinteger_or_char_p, x); \ 1250 x = wrong_type_argument (Qinteger_or_char_p, x); \
1227 } while (0) 1251 } while (0)
1228 1252
1229 #define CHECK_INT_COERCE_MARKER(x) do \ 1253 #define CHECK_INT_COERCE_MARKER(x) do \
1230 { if (INTP (x)) \ 1254 { if (INTP (x)) \
1231 ; \ 1255 ; \
1232 else if (MARKERP (x)) \ 1256 else if (MARKERP (x)) \
1233 x = make_int (marker_position (x)); \ 1257 x = make_int (marker_position (x)); \
1234 else \ 1258 else \
1235 x = wrong_type_argument (Qinteger_or_marker_p, x); \ 1259 x = wrong_type_argument (Qinteger_or_marker_p, x); \
1236 } while (0) 1260 } while (0)
1237 1261
1238 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ 1262 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \
1239 { if (INTP (x)) \ 1263 { if (INTP (x)) \
1240 ; \ 1264 ; \
1241 else if (CHARP (x)) \ 1265 else if (CHARP (x)) \
1242 x = make_int (XCHAR (x)); \ 1266 x = make_int (XCHAR (x)); \
1243 else if (MARKERP (x)) \ 1267 else if (MARKERP (x)) \
1244 x = make_int (marker_position (x)); \ 1268 x = make_int (marker_position (x)); \
1245 else \ 1269 else \
1246 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ 1270 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
1247 } while (0) 1271 } while (0)
1248 1272
1249 /*********** pure space ***********/ 1273 /*********** pure space ***********/
1250 1274
1251 #define CHECK_IMPURE(obj) \ 1275 #define CHECK_IMPURE(obj) \
1393 /* Can't be const, because then subr->doc is read-only and 1417 /* Can't be const, because then subr->doc is read-only and
1394 Snarf_documentation chokes */ 1418 Snarf_documentation chokes */
1395 1419
1396 #define DEFUN(lname, Fname, minargs, maxargs, prompt, arglist) \ 1420 #define DEFUN(lname, Fname, minargs, maxargs, prompt, arglist) \
1397 Lisp_Object Fname (DEFUN_ ## maxargs arglist) ; /* See below */ \ 1421 Lisp_Object Fname (DEFUN_ ## maxargs arglist) ; /* See below */ \
1398 static struct Lisp_Subr S##Fname = { {lrecord_subr}, \ 1422 static struct Lisp_Subr S##Fname \
1399 minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \ 1423 = { {lrecord_subr}, minargs, maxargs, prompt, 0, lname, Fname }; \
1400 Lisp_Object Fname (DEFUN_##maxargs arglist) 1424 Lisp_Object Fname (DEFUN_##maxargs arglist)
1401 1425
1402 1426
1403 /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a 1427 /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a
1404 prototype that matches maxargs, and add the obligatory 1428 prototype that matches maxargs, and add the obligatory
1413 #define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d 1437 #define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d
1414 #define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e 1438 #define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e
1415 #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f 1439 #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f
1416 #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g 1440 #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g
1417 #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h 1441 #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h
1418 1442
1419 /* WARNING: If you add defines here for higher values of maxargs, 1443 /* WARNING: If you add defines here for higher values of maxargs,
1420 make sure to also fix the clauses in primitive_funcall(), 1444 make sure to also fix the clauses in primitive_funcall(),
1421 and change the define of SUBR_MAX_ARGS above. */ 1445 and change the define of SUBR_MAX_ARGS above. */
1422 1446
1423 #include "symeval.h" 1447 #include "symeval.h"
1442 int check_quit (void); 1466 int check_quit (void);
1443 1467
1444 void signal_quit (void); 1468 void signal_quit (void);
1445 1469
1446 /* Nonzero if ought to quit now. */ 1470 /* Nonzero if ought to quit now. */
1447 #define QUITP \ 1471 #define QUITP \
1448 ((quit_check_signal_happened ? check_quit () : 0), \ 1472 ((quit_check_signal_happened ? check_quit () : 0), \
1449 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \ 1473 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
1450 || EQ (Vquit_flag, Qcritical)))) 1474 || EQ (Vquit_flag, Qcritical))))
1451 1475
1452 /* QUIT used to call QUITP, but there are some places where QUITP 1476 /* QUIT used to call QUITP, but there are some places where QUITP
1453 is called directly, and check_what_happened() should only be called 1477 is called directly, and check_what_happened() should only be called
1454 when Emacs is actually ready to quit because it could do things 1478 when Emacs is actually ready to quit because it could do things
1455 like switch threads. */ 1479 like switch threads. */
1456 #define INTERNAL_QUITP \ 1480 #define INTERNAL_QUITP \
1457 ((something_happened ? check_what_happened () : 0), \ 1481 ((something_happened ? check_what_happened () : 0), \
1458 (!NILP (Vquit_flag) && \ 1482 (!NILP (Vquit_flag) && \
1459 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) 1483 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1460 1484
1461 #define INTERNAL_REALLY_QUITP \ 1485 #define INTERNAL_REALLY_QUITP \
1462 (check_what_happened (), \ 1486 (check_what_happened (), \
1463 (!NILP (Vquit_flag) && \ 1487 (!NILP (Vquit_flag) && \
1464 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) 1488 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1465 1489
1466 /* Check quit-flag and quit if it is non-nil. Also do any other things 1490 /* Check quit-flag and quit if it is non-nil. Also do any other things
1467 that might have gotten queued until it was safe. */ 1491 that might have gotten queued until it was safe. */
1468 #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0) 1492 #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0)
1469
1470 /*
1471 #define QUIT \
1472 do {if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
1473 { Vquit_flag = Qnil; Fsignal (Qquit, Qnil); }} while (0)
1474 */
1475 1493
1476 #define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0) 1494 #define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
1477 1495
1478 1496
1479 /************************************************************************/ 1497 /************************************************************************/
1570 the appropriate macros. */ 1588 the appropriate macros. */
1571 1589
1572 #ifdef DEBUG_GCPRO 1590 #ifdef DEBUG_GCPRO
1573 1591
1574 void debug_gcpro1 (); 1592 void debug_gcpro1 ();
1575 void debug_gcpro2 (); 1593 void debug_gcpro2 (),
1576 void debug_gcpro3 (); 1594 void debug_gcpro3 ();
1577 void debug_gcpro4 (); 1595 void debug_gcpro4 ();
1578 void debug_gcpro5 (); 1596 void debug_gcpro5 ();
1579 void debug_ungcpro(); 1597 void debug_ungcpro();
1580 1598
1723 1741
1724 #endif /* ! DEBUG_GCPRO */ 1742 #endif /* ! DEBUG_GCPRO */
1725 1743
1726 /* Another try to fix SunPro C compiler warnings */ 1744 /* Another try to fix SunPro C compiler warnings */
1727 /* "end-of-loop code not reached" */ 1745 /* "end-of-loop code not reached" */
1746 #ifdef __SUNPRO_C
1747 #define RETURN__ if (1) return
1748 #else
1749 #define RETURN__ return
1750 #endif
1751
1752 /* Another try to fix SunPro C compiler warnings */
1753 /* "end-of-loop code not reached" */
1728 /* "statement not reached */ 1754 /* "statement not reached */
1729 #ifdef __SUNPRO_C 1755 #ifdef __SUNPRO_C
1730 #define RETURN__ if (1) return 1756 #define RETURN__ if (1) return
1731 #define RETURN_NOT_REACHED(value) 1757 #define RETURN_NOT_REACHED(value)
1732 #else 1758 #else
1733 #define RETURN__ return 1759 #define RETURN__ return
1734 #define RETURN_NOT_REACHED(value) return value; 1760 #define RETURN_NOT_REACHED(value) return value;
1735 #endif 1761 #endif
1736 1762
1737 /* Evaluate expr, UNGCPRO, and then return the value of expr. */ 1763 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
1738 #define RETURN_UNGCPRO(expr) do \ 1764 #define RETURN_UNGCPRO(expr) do \
1739 { \ 1765 { \
1740 Lisp_Object ret_ungc_val = (expr); \ 1766 Lisp_Object ret_ungc_val = (expr); \
1741 UNGCPRO; \ 1767 UNGCPRO; \
1742 RETURN__ ret_ungc_val; \ 1768 RETURN__ ret_ungc_val; \
1743 } while (0) 1769 } while (0)
1744 1770
1745 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ 1771 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
1746 #define RETURN_NUNGCPRO(expr) do \ 1772 #define RETURN_NUNGCPRO(expr) do \
1747 { \ 1773 { \
1748 Lisp_Object ret_ungc_val = (expr); \ 1774 Lisp_Object ret_ungc_val = (expr); \
1749 NUNGCPRO; \ 1775 NUNGCPRO; \
1750 UNGCPRO; \ 1776 UNGCPRO; \
1751 RETURN__ ret_ungc_val; \ 1777 RETURN__ ret_ungc_val; \
1752 } while (0) 1778 } while (0)
1753 1779
1754 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the 1780 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
1755 value of expr. */ 1781 value of expr. */
1756 #define RETURN_NNUNGCPRO(expr) do \ 1782 #define RETURN_NNUNGCPRO(expr) do \
1757 { \ 1783 { \
1758 Lisp_Object ret_ungc_val = (expr); \ 1784 Lisp_Object ret_ungc_val = (expr); \
1759 NNUNGCPRO; \ 1785 NNUNGCPRO; \
1760 NUNGCPRO; \ 1786 NUNGCPRO; \
1761 UNGCPRO; \ 1787 UNGCPRO; \
1762 RETURN__ ret_ungc_val; \ 1788 RETURN__ ret_ungc_val; \
1763 } while (0) 1789 } while (0)
1764 1790
1765 /* Evaluate expr, return it if it's not Qunbound. */ 1791 /* Evaluate expr, return it if it's not Qunbound. */
1766 #define RETURN_IF_NOT_UNBOUND(expr) do \ 1792 #define RETURN_IF_NOT_UNBOUND(expr) do \
1767 { \ 1793 { \
1768 Lisp_Object ret_nunb_val = (expr); \ 1794 Lisp_Object ret_nunb_val = (expr); \
1769 if (!UNBOUNDP (ret_nunb_val)) \ 1795 if (!UNBOUNDP (ret_nunb_val)) \
1770 RETURN__ ret_nunb_val; \ 1796 RETURN__ ret_nunb_val; \
1771 } while (0) 1797 } while (0)
1772 1798
1773 /* Call staticpro (&var) to protect static variable `var'. */ 1799 /* Call staticpro (&var) to protect static variable `var'. */
1774 void staticpro (Lisp_Object *); 1800 void staticpro (Lisp_Object *);
1775 1801