Mercurial > hg > xemacs-beta

comparison src/lisp.h @ 84:ac0620f6398e r20-0b92

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b92
author cvs
date Mon, 13 Aug 2007 09:08:29 +0200
parents 1ce6082ce73f
children 4be1180a9e89
comparison
equal deleted inserted replaced
83:ba3ba6e17456 84:ac0620f6398e
782 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar)) 782 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
783 783
784 /* For a list that's known to be in valid list format, where we may 784 /* For a list that's known to be in valid list format, where we may
785 be deleting the current element out of the list -- 785 be deleting the current element out of the list --
786 will abort() if the list is not in valid format */ 786 will abort() if the list is not in valid format */
787 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \ 787 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \
788 for (consvar = list; \ 788 for (consvar = list; \
789 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \ 789 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \
790 consvar = nextconsvar) 790 consvar = nextconsvar)
791 791
792 /* For a list that may not be in valid list format -- 792 /* For a list that may not be in valid list format --
793 will signal an error if the list is not in valid format */ 793 will signal an error if the list is not in valid format */
794 #define EXTERNAL_LIST_LOOP(consvar, listp) \ 794 #define EXTERNAL_LIST_LOOP(consvar, listp) \
1058 #define symbol_plist(s) ((s)->plist) 1058 #define symbol_plist(s) ((s)->plist)
1059 1059
1060 /*********** subr ***********/ 1060 /*********** subr ***********/
1061 1061
1062 typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...); 1062 typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...);
1063 1063
1064 struct Lisp_Subr 1064 struct Lisp_Subr
1065 { 1065 {
1066 struct lrecord_header lheader; 1066 struct lrecord_header lheader;
1067 short min_args, max_args; 1067 short min_args, max_args;
1068 CONST char *prompt; 1068 CONST char *prompt;
1167 x = wrong_type_argument (Qnumberp, (x)); } while (0) 1167 x = wrong_type_argument (Qnumberp, (x)); } while (0)
1168 1168
1169 /* These are always continuable because they change their arguments 1169 /* These are always continuable because they change their arguments
1170 even when no error is signalled. */ 1170 even when no error is signalled. */
1171 1171
1172 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ 1172 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \
1173 { if (INTP (x) || FLOATP (x)) \ 1173 { if (INTP (x) || FLOATP (x)) \
1174 ; \ 1174 ; \
1175 else if (MARKERP (x)) \ 1175 else if (MARKERP (x)) \
1176 x = make_int (marker_position (x)); \ 1176 x = make_int (marker_position (x)); \
1177 else \ 1177 else \
1178 x = wrong_type_argument (Qnumber_or_marker_p, x); \ 1178 x = wrong_type_argument (Qnumber_or_marker_p, x); \
1179 } while (0) 1179 } while (0)
1180 1180
1181 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ 1181 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \
1182 { if (INTP (x) || FLOATP (x)) \ 1182 { if (INTP (x) || FLOATP (x)) \
1183 ; \ 1183 ; \
1184 else if (CHARP (x)) \ 1184 else if (CHARP (x)) \
1185 x = make_int (XCHAR (x)); \ 1185 x = make_int (XCHAR (x)); \
1186 else if (MARKERP (x)) \ 1186 else if (MARKERP (x)) \
1187 x = make_int (marker_position (x)); \ 1187 x = make_int (marker_position (x)); \
1188 else \ 1188 else \
1189 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ 1189 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
1190 } while (0) 1190 } while (0)
1191 1191
1192 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) 1192 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
1193 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x)) 1193 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x))
1194 1194
1244 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0) 1244 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0)
1245 #define CONCHECK_NATNUM(x) \ 1245 #define CONCHECK_NATNUM(x) \
1246 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) 1246 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
1247 1247
1248 /* next three always continuable because they coerce their arguments. */ 1248 /* next three always continuable because they coerce their arguments. */
1249 #define CHECK_INT_COERCE_CHAR(x) do \ 1249 #define CHECK_INT_COERCE_CHAR(x) do \
1250 { if (INTP (x)) \ 1250 { if (INTP (x)) \
1251 ; \ 1251 ; \
1252 else if (CHARP (x)) \ 1252 else if (CHARP (x)) \
1253 x = make_int (XCHAR (x)); \ 1253 x = make_int (XCHAR (x)); \
1254 else \ 1254 else \
1255 x = wrong_type_argument (Qinteger_or_char_p, x); \ 1255 x = wrong_type_argument (Qinteger_or_char_p, x); \
1256 } while (0) 1256 } while (0)
1257 1257
1258 #define CHECK_INT_COERCE_MARKER(x) do \ 1258 #define CHECK_INT_COERCE_MARKER(x) do \
1259 { if (INTP (x)) \ 1259 { if (INTP (x)) \
1260 ; \ 1260 ; \
1261 else if (MARKERP (x)) \ 1261 else if (MARKERP (x)) \
1262 x = make_int (marker_position (x)); \ 1262 x = make_int (marker_position (x)); \
1263 else \ 1263 else \
1264 x = wrong_type_argument (Qinteger_or_marker_p, x); \ 1264 x = wrong_type_argument (Qinteger_or_marker_p, x); \
1265 } while (0) 1265 } while (0)
1266 1266
1267 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ 1267 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \
1268 { if (INTP (x)) \ 1268 { if (INTP (x)) \
1269 ; \ 1269 ; \
1270 else if (CHARP (x)) \ 1270 else if (CHARP (x)) \
1271 x = make_int (XCHAR (x)); \ 1271 x = make_int (XCHAR (x)); \
1272 else if (MARKERP (x)) \ 1272 else if (MARKERP (x)) \
1273 x = make_int (marker_position (x)); \ 1273 x = make_int (marker_position (x)); \
1274 else \ 1274 else \
1275 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ 1275 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
1276 } while (0) 1276 } while (0)
1277 1277
1278 /*********** pure space ***********/ 1278 /*********** pure space ***********/
1279 1279
1280 #define CHECK_IMPURE(obj) \ 1280 #define CHECK_IMPURE(obj) \
1442 #define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d 1442 #define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d
1443 #define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e 1443 #define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e
1444 #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f 1444 #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f
1445 #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g 1445 #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g
1446 #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h 1446 #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h
1447 1447
1448 /* WARNING: If you add defines here for higher values of maxargs, 1448 /* WARNING: If you add defines here for higher values of maxargs,
1449 make sure to also fix the clauses in primitive_funcall(), 1449 make sure to also fix the clauses in primitive_funcall(),
1450 and change the define of SUBR_MAX_ARGS above. */ 1450 and change the define of SUBR_MAX_ARGS above. */
1451 1451
1452 #include "symeval.h" 1452 #include "symeval.h"
1471 int check_quit (void); 1471 int check_quit (void);
1472 1472
1473 void signal_quit (void); 1473 void signal_quit (void);
1474 1474
1475 /* Nonzero if ought to quit now. */ 1475 /* Nonzero if ought to quit now. */
1476 #define QUITP \ 1476 #define QUITP \
1477 ((quit_check_signal_happened ? check_quit () : 0), \ 1477 ((quit_check_signal_happened ? check_quit () : 0), \
1478 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \ 1478 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
1479 || EQ (Vquit_flag, Qcritical)))) 1479 || EQ (Vquit_flag, Qcritical))))
1480 1480
1481 /* QUIT used to call QUITP, but there are some places where QUITP 1481 /* QUIT used to call QUITP, but there are some places where QUITP
1482 is called directly, and check_what_happened() should only be called 1482 is called directly, and check_what_happened() should only be called
1483 when Emacs is actually ready to quit because it could do things 1483 when Emacs is actually ready to quit because it could do things
1484 like switch threads. */ 1484 like switch threads. */
1485 #define INTERNAL_QUITP \ 1485 #define INTERNAL_QUITP \
1486 ((something_happened ? check_what_happened () : 0), \ 1486 ((something_happened ? check_what_happened () : 0), \
1487 (!NILP (Vquit_flag) && \ 1487 (!NILP (Vquit_flag) && \
1488 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) 1488 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1489 1489
1490 #define INTERNAL_REALLY_QUITP \ 1490 #define INTERNAL_REALLY_QUITP \
1491 (check_what_happened (), \ 1491 (check_what_happened (), \
1492 (!NILP (Vquit_flag) && \ 1492 (!NILP (Vquit_flag) && \
1493 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) 1493 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1494 1494
1495 /* Check quit-flag and quit if it is non-nil. Also do any other things 1495 /* Check quit-flag and quit if it is non-nil. Also do any other things
1496 that might have gotten queued until it was safe. */ 1496 that might have gotten queued until it was safe. */
1497 #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0) 1497 #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0)
1593 the appropriate macros. */ 1593 the appropriate macros. */
1594 1594
1595 #ifdef DEBUG_GCPRO 1595 #ifdef DEBUG_GCPRO
1596 1596
1597 void debug_gcpro1 (); 1597 void debug_gcpro1 ();
1598 void debug_gcpro2 (), 1598 void debug_gcpro2 ();
1599 void debug_gcpro3 (); 1599 void debug_gcpro3 ();
1600 void debug_gcpro4 (); 1600 void debug_gcpro4 ();
1601 void debug_gcpro5 (); 1601 void debug_gcpro5 ();
1602 void debug_ungcpro(); 1602 void debug_ungcpro();
1603 1603
1756 #define RETURN__ return 1756 #define RETURN__ return
1757 #define RETURN_NOT_REACHED(value) return value; 1757 #define RETURN_NOT_REACHED(value) return value;
1758 #endif 1758 #endif
1759 1759
1760 /* Evaluate expr, UNGCPRO, and then return the value of expr. */ 1760 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
1761 #define RETURN_UNGCPRO(expr) do \ 1761 #define RETURN_UNGCPRO(expr) do \
1762 { \ 1762 { \
1763 Lisp_Object ret_ungc_val = (expr); \ 1763 Lisp_Object ret_ungc_val = (expr); \
1764 UNGCPRO; \ 1764 UNGCPRO; \
1765 RETURN__ ret_ungc_val; \ 1765 RETURN__ ret_ungc_val; \
1766 } while (0) 1766 } while (0)
1767 1767
1768 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ 1768 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
1769 #define RETURN_NUNGCPRO(expr) do \ 1769 #define RETURN_NUNGCPRO(expr) do \
1770 { \ 1770 { \
1771 Lisp_Object ret_ungc_val = (expr); \ 1771 Lisp_Object ret_ungc_val = (expr); \
1772 NUNGCPRO; \ 1772 NUNGCPRO; \
1773 UNGCPRO; \ 1773 UNGCPRO; \
1774 RETURN__ ret_ungc_val; \ 1774 RETURN__ ret_ungc_val; \
1775 } while (0) 1775 } while (0)
1776 1776
1777 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the 1777 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
1778 value of expr. */ 1778 value of expr. */
1779 #define RETURN_NNUNGCPRO(expr) do \ 1779 #define RETURN_NNUNGCPRO(expr) do \
1780 { \ 1780 { \
1781 Lisp_Object ret_ungc_val = (expr); \ 1781 Lisp_Object ret_ungc_val = (expr); \
1782 NNUNGCPRO; \ 1782 NNUNGCPRO; \
1783 NUNGCPRO; \ 1783 NUNGCPRO; \
1784 UNGCPRO; \ 1784 UNGCPRO; \
1785 RETURN__ ret_ungc_val; \ 1785 RETURN__ ret_ungc_val; \
1786 } while (0) 1786 } while (0)
1787 1787
1788 /* Evaluate expr, return it if it's not Qunbound. */ 1788 /* Evaluate expr, return it if it's not Qunbound. */
1789 #define RETURN_IF_NOT_UNBOUND(expr) do \ 1789 #define RETURN_IF_NOT_UNBOUND(expr) do \
1790 { \ 1790 { \
1791 Lisp_Object ret_nunb_val = (expr); \ 1791 Lisp_Object ret_nunb_val = (expr); \
1792 if (!UNBOUNDP (ret_nunb_val)) \ 1792 if (!UNBOUNDP (ret_nunb_val)) \
1793 RETURN__ ret_nunb_val; \ 1793 RETURN__ ret_nunb_val; \
1794 } while (0) 1794 } while (0)
1795 1795
1796 /* Call staticpro (&var) to protect static variable `var'. */ 1796 /* Call staticpro (&var) to protect static variable `var'. */
1797 void staticpro (Lisp_Object *); 1797 void staticpro (Lisp_Object *);
1798 1798