Mercurial > hg > xemacs-beta

comparison src/lisp.h @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 859a2309aef8
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
525 user-definable with the `pathname-coding-system' variable. 525 user-definable with the `pathname-coding-system' variable.
526 For the moment, we just use the `binary' coding system. */ 526 For the moment, we just use the `binary' coding system. */
527 FORMAT_FILENAME, 527 FORMAT_FILENAME,
528 528
529 /* Format used for output to the terminal. This should be controlled 529 /* Format used for output to the terminal. This should be controlled
530 by the `display-coding-system' variable. Under kterm, this will 530 by the `terminal-coding-system' variable. Under kterm, this will
531 be some ISO2022 system. On some DOS machines, this is Shift-JIS. */ 531 be some ISO2022 system. On some DOS machines, this is Shift-JIS. */
532 FORMAT_DISPLAY, 532 FORMAT_TERMINAL,
533 533
534 /* Format used for input from the terminal. This should be controlled 534 /* Format used for input from the terminal. This should be controlled
535 by the `keyboard-coding-system' variable. */ 535 by the `keyboard-coding-system' variable. */
536 FORMAT_KEYBOARD, 536 FORMAT_KEYBOARD,
537 537
642 642
643 #ifndef LRECORD_SYMBOL 643 #ifndef LRECORD_SYMBOL
644 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ 644 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
645 ,Lisp_Symbol 645 ,Lisp_Symbol
646 #endif /* !LRECORD_SYMBOL */ 646 #endif /* !LRECORD_SYMBOL */
647 }; 647 };
648 648
649 /* unsafe! */ 649 /* unsafe! */
650 #define POINTER_TYPE_P(type) ((type) != Lisp_Int) 650 #define POINTER_TYPE_P(type) ((type) != Lisp_Int)
651 651
652 /* This should be the underlying type into which a Lisp_Object must fit. 652 /* This should be the underlying type into which a Lisp_Object must fit.
777 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar)) 777 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
778 778
779 /* For a list that's known to be in valid list format, where we may 779 /* For a list that's known to be in valid list format, where we may
780 be deleting the current element out of the list -- 780 be deleting the current element out of the list --
781 will abort() if the list is not in valid format */ 781 will abort() if the list is not in valid format */
782 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \ 782 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \
783 for (consvar = list; \ 783 for (consvar = list; \
784 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \ 784 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \
785 consvar = nextconsvar) 785 consvar = nextconsvar)
786 786
787 /* For a list that may not be in valid list format -- 787 /* For a list that may not be in valid list format --
788 will signal an error if the list is not in valid format */ 788 will signal an error if the list is not in valid format */
789 #define EXTERNAL_LIST_LOOP(consvar, listp) \ 789 #define EXTERNAL_LIST_LOOP(consvar, listp) \
1028 #define symbol_function(s) ((s)->function) 1028 #define symbol_function(s) ((s)->function)
1029 #define symbol_plist(s) ((s)->plist) 1029 #define symbol_plist(s) ((s)->plist)
1030 1030
1031 /*********** subr ***********/ 1031 /*********** subr ***********/
1032 1032
1033 typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...);
1034
1033 struct Lisp_Subr 1035 struct Lisp_Subr
1034 { 1036 {
1035 struct lrecord_header lheader; 1037 struct lrecord_header lheader;
1036 short min_args, max_args; 1038 short min_args, max_args;
1037 CONST char *prompt; 1039 CONST char *prompt;
1038 CONST char *doc; 1040 CONST char *doc;
1039 CONST char *name; 1041 CONST char *name;
1040 Lisp_Object (*subr_fn) (); 1042 lisp_fn_t subr_fn;
1041 }; 1043 };
1042 1044
1043 DECLARE_LRECORD (subr, struct Lisp_Subr); 1045 DECLARE_LRECORD (subr, struct Lisp_Subr);
1044 #define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr) 1046 #define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr)
1045 #define XSETSUBR(x, p) XSETRECORD (x, p, subr) 1047 #define XSETSUBR(x, p) XSETRECORD (x, p, subr)
1135 x = wrong_type_argument (Qnumberp, (x)); } while (0) 1137 x = wrong_type_argument (Qnumberp, (x)); } while (0)
1136 1138
1137 /* These are always continuable because they change their arguments 1139 /* These are always continuable because they change their arguments
1138 even when no error is signalled. */ 1140 even when no error is signalled. */
1139 1141
1140 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) \ 1142 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \
1141 do { if (INTP (x) || FLOATP (x)) \ 1143 { if (INTP (x) || FLOATP (x)) \
1142 ; \ 1144 ; \
1143 else if (MARKERP (x)) \ 1145 else if (MARKERP (x)) \
1144 x = make_int (marker_position (x)); \ 1146 x = make_int (marker_position (x)); \
1145 else \ 1147 else \
1146 x = wrong_type_argument (Qnumber_or_marker_p, x); } while (0) 1148 x = wrong_type_argument (Qnumber_or_marker_p, x); \
1147 1149 } while (0)
1148 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) \ 1150
1149 do { if (INTP (x) || FLOATP (x)) \ 1151 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \
1150 ; \ 1152 { if (INTP (x) || FLOATP (x)) \
1151 else if (CHARP (x)) \ 1153 ; \
1152 x = make_int (XCHAR (x)); \ 1154 else if (CHARP (x)) \
1153 else if (MARKERP (x)) \ 1155 x = make_int (XCHAR (x)); \
1154 x = make_int (marker_position (x)); \ 1156 else if (MARKERP (x)) \
1155 else \ 1157 x = make_int (marker_position (x)); \
1156 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ 1158 else \
1157 } while (0) 1159 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
1160 } while (0)
1158 1161
1159 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) 1162 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
1160 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x)) 1163 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x))
1161 1164
1162 #else /* not LISP_FLOAT_TYPE */ 1165 #else /* not LISP_FLOAT_TYPE */
1211 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0) 1214 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0)
1212 #define CONCHECK_NATNUM(x) \ 1215 #define CONCHECK_NATNUM(x) \
1213 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) 1216 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
1214 1217
1215 /* next three always continuable because they coerce their arguments. */ 1218 /* next three always continuable because they coerce their arguments. */
1216 #define CHECK_INT_COERCE_CHAR(x) \ 1219 #define CHECK_INT_COERCE_CHAR(x) do \
1217 do { if (INTP (x)) \ 1220 { if (INTP (x)) \
1218 ; \ 1221 ; \
1219 else if (CHARP (x)) \ 1222 else if (CHARP (x)) \
1220 x = make_int (XCHAR (x)); \ 1223 x = make_int (XCHAR (x)); \
1221 else \ 1224 else \
1222 x = wrong_type_argument (Qinteger_or_char_p, x); } while (0) 1225 x = wrong_type_argument (Qinteger_or_char_p, x); \
1223 1226 } while (0)
1224 #define CHECK_INT_COERCE_MARKER(x) \ 1227
1225 do { if (INTP (x)) \ 1228 #define CHECK_INT_COERCE_MARKER(x) do \
1226 ; \ 1229 { if (INTP (x)) \
1227 else if (MARKERP (x)) \ 1230 ; \
1228 x = make_int (marker_position (x)); \ 1231 else if (MARKERP (x)) \
1229 else \ 1232 x = make_int (marker_position (x)); \
1230 x = wrong_type_argument (Qinteger_or_marker_p, x); } while (0) 1233 else \
1231 1234 x = wrong_type_argument (Qinteger_or_marker_p, x); \
1232 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) \ 1235 } while (0)
1233 do { if (INTP (x)) \ 1236
1234 ; \ 1237 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \
1235 else if (CHARP (x)) \ 1238 { if (INTP (x)) \
1236 x = make_int (XCHAR (x)); \ 1239 ; \
1237 else if (MARKERP (x)) \ 1240 else if (CHARP (x)) \
1238 x = make_int (marker_position (x)); \ 1241 x = make_int (XCHAR (x)); \
1239 else \ 1242 else if (MARKERP (x)) \
1240 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ 1243 x = make_int (marker_position (x)); \
1241 } while (0) 1244 else \
1245 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
1246 } while (0)
1242 1247
1243 /*********** pure space ***********/ 1248 /*********** pure space ***********/
1244 1249
1245 #define CHECK_IMPURE(obj) \ 1250 #define CHECK_IMPURE(obj) \
1246 do { if (purified (obj)) pure_write_error (); } while (0) 1251 do { if (purified (obj)) pure_write_error (); } while (0)
1352 1357
1353 /************************************************************************/ 1358 /************************************************************************/
1354 /* Definitions of primitive Lisp functions and variables */ 1359 /* Definitions of primitive Lisp functions and variables */
1355 /************************************************************************/ 1360 /************************************************************************/
1356 1361
1357 /* Define a built-in function for calling from Lisp. 1362
1363 /* DEFUN - Define a built-in Lisp-visible C function or `subr'.
1358 `lname' should be the name to give the function in Lisp, 1364 `lname' should be the name to give the function in Lisp,
1359 as a null-terminated C string. 1365 as a null-terminated C string.
1360 `fnname' should be the name of the function in C. 1366 `Fname' should be the C equivalent of `lname', using only characters
1361 By convention, it starts with F. 1367 valid in a C identifier, with an "F" prepended.
1362 `sname' should be the name for the C constant structure 1368 `sname' should be the name for the C constant structure
1363 that records information on this function for internal use. 1369 that records information on this function for internal use.
1364 By convention, it should be the same as `fnname' but with S instead of F. 1370 By convention, it should be the same as `fnname' but with S instead of F.
1365 It's too bad that C macros can't compute this from `fnname'. 1371 It's too bad that C macros can't compute this from `fnname'.
1366 `minargs' should be a number, the minimum number of arguments allowed. 1372 `minargs' should be a number, the minimum number of arguments allowed.
1368 or else MANY or UNEVALLED. 1374 or else MANY or UNEVALLED.
1369 MANY means pass a vector of evaluated arguments, 1375 MANY means pass a vector of evaluated arguments,
1370 in the form of an integer number-of-arguments 1376 in the form of an integer number-of-arguments
1371 followed by the address of a vector of Lisp_Objects 1377 followed by the address of a vector of Lisp_Objects
1372 which contains the argument values. 1378 which contains the argument values.
1373 UNEVALLED means pass the list of unevaluated arguments 1379 UNEVALLED means pass the list of unevaluated arguments.
1374 `prompt' says how to read arguments for an interactive call. 1380 `prompt' says how to read arguments for an interactive call.
1375 See the doc string for `interactive'. 1381 See the doc string for `interactive'.
1376 A null string means call interactively with no arguments. 1382 A null string means call interactively with no arguments.
1377 `doc' is documentation for the user. 1383 `arglist' are the comma-separated arguments (always Lisp_Objects) for
1384 the function.
1385 The docstring for the function is placed as a "C" comment between
1386 the prompt and the `args' argument. make-docfile reads the
1387 comment and creates the DOC file form it.
1378 */ 1388 */
1379 1389
1380 #define SUBR_MAX_ARGS 8 1390 #define SUBR_MAX_ARGS 8
1381 #define MANY -2 1391 #define MANY -2
1382 #define UNEVALLED -1 1392 #define UNEVALLED -1
1383 1393
1384 /* Can't be const, because then subr->doc is read-only and 1394 /* Can't be const, because then subr->doc is read-only and
1385 * FSnarf_documentation chokes */ 1395 Snarf_documentation chokes */
1386 #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt) \ 1396 #define DEFUN(lname, Fname, sname, minargs, maxargs, prompt) \
1387 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; /* See below */ \ 1397 Lisp_Object Fname ( DEFUN__ ## maxargs ) ; /* See below */ \
1388 static struct Lisp_Subr sname \ 1398 static struct Lisp_Subr sname \
1389 = { { lrecord_subr }, minargs, maxargs, prompt, 0, lname, fnname }; \ 1399 = { { lrecord_subr }, minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \
1390 Lisp_Object fnname 1400 Lisp_Object Fname
1391 1401
1392 /* Scary ANSI C preprocessor hackery by Felix Lee <flee@guardian.cse.psu.edu> 1402 /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a
1393 to get DEFUN to declare a prototype that matches maxargs, so that the 1403 prototype that matches maxargs, and add the obligatory
1394 compiler can complain if the "real" arglist doesn't match. Clever hack 1404 `Lisp_Object' type declaration to the formal C arguments. */
1395 or repulsive kludge? You be the judge. 1405
1396 */ 1406 #define DEFUN_MANY(named_int, named_Lisp_Object) int named_int, Lisp_Object *named_Lisp_Object
1397 1407 #define DEFUN_UNEVALLED(args) Lisp_Object args
1398 /* WARNING: If you add defines below for higher values of maxargs, 1408 #define DEFUN_0() void
1399 make sure to also fix the clauses in primitive_funcall(). */ 1409 #define DEFUN_1(a) Lisp_Object a
1400 1410 #define DEFUN_2(a,b) DEFUN_1(a), Lisp_Object b
1401 #define DEFUN_ARGS_MANY (int, Lisp_Object *) 1411 #define DEFUN_3(a,b,c) DEFUN_2(a,b), Lisp_Object c
1402 #define DEFUN_ARGS_UNEVALLED (Lisp_Object) 1412 #define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d
1403 #define DEFUN_ARGS_0 (void) 1413 #define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e
1404 #define DEFUN_ARGS_1 (Lisp_Object) 1414 #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f
1405 #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object) 1415 #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g
1406 #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object) 1416 #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h
1407 #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) 1417
1408 #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1418 #define DEFUN__MANY DEFUN_MANY(argc,argv)
1409 Lisp_Object) 1419 #define DEFUN__UNEVALLED DEFUN_UNEVALLED(args)
1410 #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1420 #define DEFUN__0 DEFUN_0()
1411 Lisp_Object, Lisp_Object) 1421 #define DEFUN__1 DEFUN_1(a)
1412 #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1422 #define DEFUN__2 DEFUN_2(a,b)
1413 Lisp_Object, Lisp_Object, Lisp_Object) 1423 #define DEFUN__3 DEFUN_3(a,b,c)
1414 #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1424 #define DEFUN__4 DEFUN_4(a,b,c,d)
1415 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) 1425 #define DEFUN__5 DEFUN_5(a,b,c,d,e)
1416 #define DEFUN_ARGS_9 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1426 #define DEFUN__6 DEFUN_6(a,b,c,d,e,f)
1417 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1427 #define DEFUN__7 DEFUN_7(a,b,c,d,e,f,g)
1418 Lisp_Object) 1428 #define DEFUN__8 DEFUN_8(a,b,c,d,e,f,g,h)
1419 #define DEFUN_ARGS_10 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1429
1420 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1430 /* WARNING: If you add defines here for higher values of maxargs,
1421 Lisp_Object, Lisp_Object) 1431 make sure to also fix the clauses in primitive_funcall(),
1422 #define DEFUN_ARGS_11 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 1432 and change the define of SUBR_MAX_ARGS above. */
1423 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1424 Lisp_Object, Lisp_Object, Lisp_Object)
1425 #define DEFUN_ARGS_12 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1426 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1427 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1428 1433
1429 #include "symeval.h" 1434 #include "symeval.h"
1430 1435
1431 /* Depth of special binding/unwind-protect stack. Use as arg to unbind_to */ 1436 /* Depth of special binding/unwind-protect stack. Use as arg to `unbind_to' */
1432 int specpdl_depth (void); 1437 int specpdl_depth (void);
1433 1438
1434 1439
1435 /************************************************************************/ 1440 /************************************************************************/
1436 /* Checking for QUIT */ 1441 /* Checking for QUIT */
1448 int check_quit (void); 1453 int check_quit (void);
1449 1454
1450 void signal_quit (void); 1455 void signal_quit (void);
1451 1456
1452 /* Nonzero if ought to quit now. */ 1457 /* Nonzero if ought to quit now. */
1453 #define QUITP ((quit_check_signal_happened ? check_quit () : 0), \ 1458 #define QUITP \
1454 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \ 1459 ((quit_check_signal_happened ? check_quit () : 0), \
1455 || EQ (Vquit_flag, Qcritical)))) 1460 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
1461 || EQ (Vquit_flag, Qcritical))))
1456 1462
1457 /* QUIT used to call QUITP, but there are some places where QUITP 1463 /* QUIT used to call QUITP, but there are some places where QUITP
1458 is called directly, and check_what_happened() should only be called 1464 is called directly, and check_what_happened() should only be called
1459 when Emacs is actually ready to quit because it could do things 1465 when Emacs is actually ready to quit because it could do things
1460 like switch threads. */ 1466 like switch threads. */
1468 (!NILP (Vquit_flag) && \ 1474 (!NILP (Vquit_flag) && \
1469 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) 1475 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1470 1476
1471 /* Check quit-flag and quit if it is non-nil. Also do any other things 1477 /* Check quit-flag and quit if it is non-nil. Also do any other things
1472 that might have gotten queued until it was safe. */ 1478 that might have gotten queued until it was safe. */
1473 #define QUIT \ 1479 #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0)
1474 do { if (INTERNAL_QUITP) signal_quit (); } while (0) 1480
1475 1481 #define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
1476 #define REALLY_QUIT \
1477 do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
1478 1482
1479 1483
1480 /************************************************************************/ 1484 /************************************************************************/
1481 /* hashing */ 1485 /* hashing */
1482 /************************************************************************/ 1486 /************************************************************************/
1483 1487
1484 /* #### for a 64-bit machine, we should substitute a prime just over 1488 /* #### for a 64-bit machine, we should substitute a prime just over 2^32 */
1485 2^32 */ 1489 #define GOOD_HASH 65599 /* prime number just over 2^16; Dragon book, p. 435 */
1486 #define GOOD_HASH_VALUE 65599 /* prime number just over 2^16; 1490 #define HASH2(a,b) (GOOD_HASH * (a) + (b))
1487 Dragon book, p. 435 */ 1491 #define HASH3(a,b,c) (GOOD_HASH * HASH2 (a,b) + (c))
1488 #define HASH2(a, b) ((a) * GOOD_HASH_VALUE + (b)) 1492 #define HASH4(a,b,c,d) (GOOD_HASH * HASH3 (a,b,c) + (d))
1489 #define HASH3(a, b, c) (HASH2 (a, b) * GOOD_HASH_VALUE + (c)) 1493 #define HASH5(a,b,c,d,e) (GOOD_HASH * HASH4 (a,b,c,d) + (e))
1490 #define HASH4(a, b, c, d) (HASH3 (a, b, c) * GOOD_HASH_VALUE + (d)) 1494 #define HASH6(a,b,c,d,e,f) (GOOD_HASH * HASH5 (a,b,c,d,e) + (f))
1491 #define HASH5(a, b, c, d, e) (HASH4 (a, b, c, d) * GOOD_HASH_VALUE + (e)) 1495 #define HASH7(a,b,c,d,e,f,g) (GOOD_HASH * HASH6 (a,b,c,d,e,f) + (g))
1492 #define HASH6(a, b, c, d, e, f) (HASH5 (a, b, c, d, e) * GOOD_HASH_VALUE + (f)) 1496 #define HASH8(a,b,c,d,e,f,g,h) (GOOD_HASH * HASH7 (a,b,c,d,e,f,g) + (h))
1493 #define HASH7(a, b, c, d, e, f, g) \ 1497 #define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i))
1494 (HASH6 (a, b, c, d, e, f) * GOOD_HASH_VALUE + (g))
1495 #define HASH8(a, b, c, d, e, f, g, h) \
1496 (HASH7 (a, b, c, d, e, f, g) * GOOD_HASH_VALUE + (h))
1497 #define HASH9(a, b, c, d, e, f, g, h, i) \
1498 (HASH8 (a, b, c, d, e, f, g, h) * GOOD_HASH_VALUE + (i))
1499 1498
1500 /* Enough already! */ 1499 /* Enough already! */
1501 1500
1502 #define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj)) 1501 #define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj))
1503 unsigned long string_hash (CONST void *xv); 1502 unsigned long string_hash (CONST void *xv);
1575 NNGCPROn(). If you need to nest yet another level, create 1574 NNGCPROn(). If you need to nest yet another level, create
1576 the appropriate macros. */ 1575 the appropriate macros. */
1577 1576
1578 #ifdef DEBUG_GCPRO 1577 #ifdef DEBUG_GCPRO
1579 1578
1580 void debug_gcpro1 (), debug_gcpro2 (), debug_gcpro3 (), debug_gcpro4 (); 1579 void debug_gcpro1 ();
1581 void debug_gcpro_5 (), debug_ungcpro (); 1580 void debug_gcpro2 ();
1581 void debug_gcpro3 ();
1582 void debug_gcpro4 ();
1583 void debug_gcpro5 ();
1584 void debug_ungcpro();
1582 1585
1583 #define GCPRO1(v) \ 1586 #define GCPRO1(v) \
1584 debug_gcpro1 (__FILE__, __LINE__,&gcpro1,&v) 1587 debug_gcpro1 (__FILE__, __LINE__,&gcpro1,&v)
1585 #define GCPRO2(v1,v2) \ 1588 #define GCPRO2(v1,v2) \
1586 debug_gcpro2 (__FILE__, __LINE__,&gcpro1,&gcpro2,&v1,&v2) 1589 debug_gcpro2 (__FILE__, __LINE__,&gcpro1,&gcpro2,&v1,&v2)
1631 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ 1634 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
1632 gcprolist = &gcpro1; } 1635 gcprolist = &gcpro1; }
1633 1636
1634 #define GCPRO2(varname1, varname2) \ 1637 #define GCPRO2(varname1, varname2) \
1635 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ 1638 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1636 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ 1639 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1637 gcprolist = &gcpro2; } 1640 gcprolist = &gcpro2; }
1638 1641
1639 #define GCPRO3(varname1, varname2, varname3) \ 1642 #define GCPRO3(varname1, varname2, varname3) \
1640 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ 1643 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1641 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ 1644 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1722 gcprolist = &nngcpro5; } 1725 gcprolist = &nngcpro5; }
1723 1726
1724 #define NNUNGCPRO (gcprolist = nngcpro1.next) 1727 #define NNUNGCPRO (gcprolist = nngcpro1.next)
1725 1728
1726 #endif /* ! DEBUG_GCPRO */ 1729 #endif /* ! DEBUG_GCPRO */
1727
1728 /* Another try to fix SunPro C compiler warnings */
1729 /* "end-of-loop code not reached" */
1730 #ifdef __SUNPRO_C
1731 #define RETURN__ if (1) return
1732 #else
1733 #define RETURN__ return
1734 #endif
1735 1730
1736 /* Another try to fix SunPro C compiler warnings */ 1731 /* Another try to fix SunPro C compiler warnings */
1737 /* "end-of-loop code not reached" */ 1732 /* "end-of-loop code not reached" */
1738 /* "statement not reached */ 1733 /* "statement not reached */
1739 #ifdef __SUNPRO_C 1734 #ifdef __SUNPRO_C
1743 #define RETURN__ return 1738 #define RETURN__ return
1744 #define RETURN_NOT_REACHED(value) return value; 1739 #define RETURN_NOT_REACHED(value) return value;
1745 #endif 1740 #endif
1746 1741
1747 /* Evaluate expr, UNGCPRO, and then return the value of expr. */ 1742 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
1748 #define RETURN_UNGCPRO(expr) do \ 1743 #define RETURN_UNGCPRO(expr) do \
1749 { \ 1744 { \
1750 Lisp_Object ret_ungc_val = (expr); \ 1745 Lisp_Object ret_ungc_val = (expr); \
1751 UNGCPRO; \ 1746 UNGCPRO; \
1752 RETURN__ ret_ungc_val; \ 1747 RETURN__ ret_ungc_val; \
1753 } while (0) 1748 } while (0)
1754 1749
1755 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ 1750 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
1756 #define RETURN_NUNGCPRO(expr) do \ 1751 #define RETURN_NUNGCPRO(expr) do \
1757 { \ 1752 { \
1758 Lisp_Object ret_ungc_val = (expr); \ 1753 Lisp_Object ret_ungc_val = (expr); \
1759 NUNGCPRO; \ 1754 NUNGCPRO; \
1760 UNGCPRO; \ 1755 UNGCPRO; \
1761 RETURN__ ret_ungc_val; \ 1756 RETURN__ ret_ungc_val; \
1762 } while (0) 1757 } while (0)
1763 1758
1764 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the 1759 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
1765 value of expr. */ 1760 value of expr. */
1766 #define RETURN_NNUNGCPRO(expr) do \ 1761 #define RETURN_NNUNGCPRO(expr) do \
1767 { \ 1762 { \
1768 Lisp_Object ret_ungc_val = (expr); \ 1763 Lisp_Object ret_ungc_val = (expr); \
1769 NNUNGCPRO; \ 1764 NNUNGCPRO; \
1770 NUNGCPRO; \ 1765 NUNGCPRO; \
1771 UNGCPRO; \ 1766 UNGCPRO; \
1772 RETURN__ ret_ungc_val; \ 1767 RETURN__ ret_ungc_val; \
1773 } while (0) 1768 } while (0)
1774 1769
1775 /* Evaluate expr, return it if it's not Qunbound. */ 1770 /* Evaluate expr, return it if it's not Qunbound. */
1776 #define RETURN_IF_NOT_UNBOUND(expr) do \ 1771 #define RETURN_IF_NOT_UNBOUND(expr) do \
1777 { \ 1772 { \
1778 Lisp_Object ret_nunb_val = (expr); \ 1773 Lisp_Object ret_nunb_val = (expr); \
1779 if (!UNBOUNDP (ret_nunb_val)) \ 1774 if (!UNBOUNDP (ret_nunb_val)) \
1780 RETURN__ ret_nunb_val; \ 1775 RETURN__ ret_nunb_val; \
1781 } while (0) 1776 } while (0)
1782 1777
1783 /* Call staticpro (&var) to protect static variable `var'. */ 1778 /* Call staticpro (&var) to protect static variable `var'. */
1784 void staticpro (Lisp_Object *); 1779 void staticpro (Lisp_Object *);
1785 1780