Mercurial > hg > xemacs-beta
diff src/lisp.h @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | c0965ff3b039 |
children | 54cc21c15cbb |
line wrap: on
line diff
--- a/src/lisp.h Mon Aug 13 09:00:04 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:02:59 2007 +0200 @@ -169,30 +169,30 @@ macro will realloc BASEVAR as necessary so that it can hold at least NEEDED_SIZE objects. The reallocing is done by doubling, which ensures constant amortized time per element. */ -#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ -{ \ - /* Avoid side-effectualness. */ \ - /* Dammit! Macros suffer from dynamic scope! */ \ - /* We demand inline functions! */ \ - int do_realloc_needed_size = (needed_size); \ - int newsize = 0; \ - while ((sizevar) < (do_realloc_needed_size)) { \ - newsize = 2*(sizevar); \ - if (newsize < 32) \ - newsize = 32; \ - (sizevar) = newsize; \ - } \ - if (newsize) \ - (basevar) = (type *) xrealloc (basevar, \ - (newsize)*sizeof(type)); \ +#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ +{ \ + /* Avoid side-effectualness. */ \ + /* Dammit! Macros suffer from dynamic scope! */ \ + /* We demand inline functions! */ \ + int do_realloc_needed_size = (needed_size); \ + int newsize = 0; \ + while ((sizevar) < (do_realloc_needed_size)) { \ + newsize = 2*(sizevar); \ + if (newsize < 32) \ + newsize = 32; \ + (sizevar) = newsize; \ + } \ + if (newsize) \ + (basevar) = (type *) xrealloc (basevar, \ + (newsize)*sizeof(type)); \ } while (0) #ifdef ERROR_CHECK_MALLOC -#define xfree(lvalue) do \ -{ \ - void **ptr = (void **) &(lvalue); \ - xfree_1 (*ptr); \ - *ptr = (void *) 0xDEADBEEF; \ +#define xfree(lvalue) do \ +{ \ + void **ptr = (void **) &(lvalue); \ + xfree_1 (*ptr); \ + *ptr = (void *) 0xDEADBEEF; \ } while (0) #else #define xfree_1 xfree @@ -251,15 +251,12 @@ ((((len) + (unit) - 1) / (unit)) * (unit)) /* #### Yuck, this is kind of evil */ -#define ALIGN_PTR(ptr, unit) \ - ((void *) ALIGN_SIZE ((long) (ptr), unit)) +#define ALIGN_PTR(ptr, unit) ((void *) ALIGN_SIZE ((long) (ptr), unit)) #ifdef QUANTIFY #include "quantify.h" -#define QUANTIFY_START_RECORDING \ - do { quantify_start_recording_data (); } while (0) -#define QUANTIFY_STOP_RECORDING \ - do { quantify_stop_recording_data (); } while (0) +#define QUANTIFY_START_RECORDING quantify_start_recording_data () +#define QUANTIFY_STOP_RECORDING quantify_stop_recording_data () #else /* !QUANTIFY */ #define QUANTIFY_START_RECORDING #define QUANTIFY_STOP_RECORDING @@ -274,12 +271,11 @@ assert checks take is measurable so let's not include them in production binaries. */ -#define abort() (assert_failed (__FILE__, __LINE__, "abort()")) - #ifdef USE_ASSERTIONS /* Highly dubious kludge */ /* (thanks, Jamie, I feel better now -- ben) */ DECLARE_DOESNT_RETURN (assert_failed (CONST char *, int, CONST char *)); +# define abort() (assert_failed (__FILE__, __LINE__, "abort()")) # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x)) #else # ifdef DEBUG_XEMACS @@ -610,7 +606,7 @@ /* There's not any particular reason not to use lrecords for these; some objects get slightly larger, but we get 3 bit tags instead of 4. */ -/* #define LRECORD_SYMBOL */ +#define LRECORD_SYMBOL /* Define the fundamental Lisp data structures */ @@ -645,10 +641,12 @@ /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ ,Lisp_Symbol #endif /* !LRECORD_SYMBOL */ + + ,Lisp_Char /* 5 DTP-CHAR */ }; /* unsafe! */ -#define POINTER_TYPE_P(type) ((type) != Lisp_Int) +#define POINTER_TYPE_P(type) ((type) != Lisp_Int && (type) != Lisp_Char) /* This should be the underlying type into which a Lisp_Object must fit. In a strict ANSI world, this must be `int', since ANSI says you can't @@ -704,12 +702,15 @@ && !POINTER_TYPE_P (XGCTYPE (obj2)) \ && XREALINT (obj1) == XREALINT (obj2))) -INLINE int HACKEQ (Lisp_Object obj1, Lisp_Object obj2); -INLINE int -HACKEQ (Lisp_Object obj1, Lisp_Object obj2) -{ - return HACKEQ_UNSAFE (obj1, obj2); -} +#ifdef DEBUG_XEMACS +extern int debug_issue_ebola_notices; +int eq_with_ebola_notice (Lisp_Object, Lisp_Object); +#define EQ_WITH_EBOLA_NOTICE(obj1, obj2) \ + (debug_issue_ebola_notices ? eq_with_ebola_notice (obj1, obj2) \ + : EQ (obj1, obj2)) +#else +#define EQ_WITH_EBOLA_NOTICE(obj1, obj2) EQ (obj1, obj2) +#endif /* OK, you can open them again */ @@ -780,9 +781,9 @@ /* For a list that's known to be in valid list format, where we may be deleting the current element out of the list -- will abort() if the list is not in valid format */ -#define LIST_LOOP_DELETING(consvar, nextconsvar, list) \ - for (consvar = list; \ - !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \ +#define LIST_LOOP_DELETING(consvar, nextconsvar, list) \ + for (consvar = list; \ + !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \ consvar = nextconsvar) /* For a list that may not be in valid list format -- @@ -848,10 +849,18 @@ #endif +#ifdef MULE + +Charcount bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len); +Bytecount charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len); + +#else /* not MULE */ # define bytecount_to_charcount(ptr, len) (len) # define charcount_to_bytecount(ptr, len) (len) +#endif /* not MULE */ + #define string_length(s) ((s)->_size) #define XSTRING_LENGTH(s) string_length (XSTRING (s)) #define string_data(s) ((s)->_data + 0) @@ -865,11 +874,27 @@ void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta); +#ifdef MULE + +INLINE Charcount string_char_length (struct Lisp_String *s); +INLINE Charcount +string_char_length (struct Lisp_String *s) +{ + return bytecount_to_charcount (string_data (s), string_length (s)); +} + +# define string_char(s, i) charptr_emchar_n (string_data (s), i) +# define string_char_addr(s, i) charptr_n_addr (string_data (s), i) +void set_string_char (struct Lisp_String *s, Charcount i, Emchar c); + +#else /* not MULE */ + # define string_char_length(s) string_length (s) # define string_char(s, i) ((Emchar) string_byte (s, i)) # define string_char_addr(s, i) string_byte_addr (s, i) # define set_string_char(s, i, c) set_string_byte (s, i, c) +#endif /* not MULE */ /*********** vector ***********/ @@ -1031,8 +1056,6 @@ /*********** subr ***********/ -typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...); - struct Lisp_Subr { struct lrecord_header lheader; @@ -1040,7 +1063,7 @@ CONST char *prompt; CONST char *doc; CONST char *name; - lisp_fn_t subr_fn; + Lisp_Object (*subr_fn) (); }; DECLARE_LRECORD (subr, struct Lisp_Subr); @@ -1081,8 +1104,8 @@ /*********** char ***********/ -#define CHARP(x) (INTP (x)) -#define GC_CHARP(x) (GC_INTP (x)) +#define CHARP(x) (XTYPE (x) == Lisp_Char) +#define GC_CHARP(x) (XGCTYPE (x) == Lisp_Char) #ifdef ERROR_CHECK_TYPECHECK @@ -1090,17 +1113,18 @@ INLINE Emchar XCHAR (Lisp_Object obj) { + assert (CHARP (obj)); return XREALINT (obj); } #else -#define XCHAR(x) (XINT (x)) +#define XCHAR(x) XREALINT (x) #endif -#define CHECK_CHAR(x) (CHECK_INT (x)) -#define CONCHECK_CHAR(x) (CONCHECK_INT (x)) +#define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Char, Qcharacterp) +#define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Char, Qcharacterp) /*********** float ***********/ @@ -1140,24 +1164,24 @@ /* These are always continuable because they change their arguments even when no error is signalled. */ -#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ -{ if (INTP (x) || FLOATP (x)) \ - ; \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qnumber_or_marker_p, x); \ +#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ +{ if (INTP (x) || FLOATP (x)) \ + ; \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qnumber_or_marker_p, x); \ } while (0) -#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ -{ if (INTP (x) || FLOATP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ +#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ +{ if (INTP (x) || FLOATP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ } while (0) # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) @@ -1217,33 +1241,33 @@ do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) /* next three always continuable because they coerce their arguments. */ -#define CHECK_INT_COERCE_CHAR(x) do \ -{ if (INTP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else \ - x = wrong_type_argument (Qinteger_or_char_p, x); \ +#define CHECK_INT_COERCE_CHAR(x) do \ +{ if (INTP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else \ + x = wrong_type_argument (Qinteger_or_char_p, x); \ } while (0) -#define CHECK_INT_COERCE_MARKER(x) do \ -{ if (INTP (x)) \ - ; \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qinteger_or_marker_p, x); \ +#define CHECK_INT_COERCE_MARKER(x) do \ +{ if (INTP (x)) \ + ; \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qinteger_or_marker_p, x); \ } while (0) -#define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ -{ if (INTP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ +#define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ +{ if (INTP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ } while (0) /*********** pure space ***********/ @@ -1395,8 +1419,8 @@ #define DEFUN(lname, Fname, minargs, maxargs, prompt, arglist) \ Lisp_Object Fname (DEFUN_ ## maxargs arglist) ; /* See below */ \ - static struct Lisp_Subr S##Fname = { {lrecord_subr}, \ - minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \ + static struct Lisp_Subr S##Fname \ + = { {lrecord_subr}, minargs, maxargs, prompt, 0, lname, Fname }; \ Lisp_Object Fname (DEFUN_##maxargs arglist) @@ -1415,7 +1439,7 @@ #define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h - + /* WARNING: If you add defines here for higher values of maxargs, make sure to also fix the clauses in primitive_funcall(), and change the define of SUBR_MAX_ARGS above. */ @@ -1444,35 +1468,29 @@ void signal_quit (void); /* Nonzero if ought to quit now. */ -#define QUITP \ - ((quit_check_signal_happened ? check_quit () : 0), \ - (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \ - || EQ (Vquit_flag, Qcritical)))) +#define QUITP \ + ((quit_check_signal_happened ? check_quit () : 0), \ + (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \ + || EQ (Vquit_flag, Qcritical)))) /* QUIT used to call QUITP, but there are some places where QUITP is called directly, and check_what_happened() should only be called when Emacs is actually ready to quit because it could do things like switch threads. */ -#define INTERNAL_QUITP \ - ((something_happened ? check_what_happened () : 0), \ - (!NILP (Vquit_flag) && \ +#define INTERNAL_QUITP \ + ((something_happened ? check_what_happened () : 0), \ + (!NILP (Vquit_flag) && \ (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) -#define INTERNAL_REALLY_QUITP \ - (check_what_happened (), \ - (!NILP (Vquit_flag) && \ +#define INTERNAL_REALLY_QUITP \ + (check_what_happened (), \ + (!NILP (Vquit_flag) && \ (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical)))) /* Check quit-flag and quit if it is non-nil. Also do any other things that might have gotten queued until it was safe. */ #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0) -/* -#define QUIT \ - do {if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ - { Vquit_flag = Qnil; Fsignal (Qquit, Qnil); }} while (0) -*/ - #define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0) @@ -1572,7 +1590,7 @@ #ifdef DEBUG_GCPRO void debug_gcpro1 (); -void debug_gcpro2 (); +void debug_gcpro2 (), void debug_gcpro3 (); void debug_gcpro4 (); void debug_gcpro5 (); @@ -1725,6 +1743,14 @@ /* Another try to fix SunPro C compiler warnings */ /* "end-of-loop code not reached" */ +#ifdef __SUNPRO_C +#define RETURN__ if (1) return +#else +#define RETURN__ return +#endif + +/* Another try to fix SunPro C compiler warnings */ +/* "end-of-loop code not reached" */ /* "statement not reached */ #ifdef __SUNPRO_C #define RETURN__ if (1) return @@ -1735,39 +1761,39 @@ #endif /* Evaluate expr, UNGCPRO, and then return the value of expr. */ -#define RETURN_UNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_UNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ -#define RETURN_NUNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - NUNGCPRO; \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_NUNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + NUNGCPRO; \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the value of expr. */ -#define RETURN_NNUNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - NNUNGCPRO; \ - NUNGCPRO; \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_NNUNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + NNUNGCPRO; \ + NUNGCPRO; \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, return it if it's not Qunbound. */ -#define RETURN_IF_NOT_UNBOUND(expr) do \ -{ \ - Lisp_Object ret_nunb_val = (expr); \ - if (!UNBOUNDP (ret_nunb_val)) \ - RETURN__ ret_nunb_val; \ +#define RETURN_IF_NOT_UNBOUND(expr) do \ +{ \ + Lisp_Object ret_nunb_val = (expr); \ + if (!UNBOUNDP (ret_nunb_val)) \ + RETURN__ ret_nunb_val; \ } while (0) /* Call staticpro (&var) to protect static variable `var'. */