=== modified file 'ChangeLog' --- ChangeLog 2013-06-11 18:05:05 +0000 +++ ChangeLog 2013-06-13 14:17:01 +0000 @@ -1,3 +1,9 @@ +2013-06-13 Paul Eggert + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + 2013-06-11 Paul Eggert --without-all should imply --with-file-notification=no. (Bug#14569) === modified file 'configure.ac' --- configure.ac 2013-06-13 06:28:05 +0000 +++ configure.ac 2013-06-13 14:17:01 +0000 @@ -776,6 +776,7 @@ # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # . === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-13 05:13:05 +0000 +++ src/ChangeLog 2013-06-13 14:17:01 +0000 @@ -1,3 +1,128 @@ +2013-06-13 Paul Eggert + + Use functions, not macros, for XINT etc. (Bug#11935). + In lisp.h, prefer functions to function-like macros, and + constants to object-like macros, when either will do. This: + . simplifies use, as there's no more need to worry about + arguments' side effects being evaluated multiple times. + . makes the code easier to debug on some platforms. + However, when using gcc -O0, keep using function-like macros + for a few critical operations, for performance reasons. + This sort of thing isn't needed with gcc -Og, but -Og + is a GCC 4.8 feature and isn't widely-enough available yet. + * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: + Remove enum lsb_bits; no longer needed. + (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue. + * buffer.c (Qoverlap): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + Now extern, so lisp.h can use these symbols. + * dispextern.h: Include character.h, for MAX_CHAR etc. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move here from lisp.h. + (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. + (GLYPH_MODE_LINE_FACE): Now enums, not macros. + * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since + XUNTAG now returns void *. + * lisp.h (lisp_h_XLI, lisp_h_XIL, lisp_h_CHECK_LIST_CONS) + (lisp_h_CHECK_NUMBER CHECK_SYMBOL, lisp_h_CHECK_TYPE) + (lisp_h_CONSP, lisp_h_EQ, lisp_h_FLOATP, lisp_h_INTEGERP) + (lisp_h_LISP_INT_TAG_P, lisp_h_MARKERP, lisp_h_MISCP, lisp_h_NILP) + (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_CONSTANT_P) + (lisp_h_SYMBOL_VAL, lisp_h_SYMBOLP, lisp_h_VECTORLIKEP) + (lisp_h_XCAR, lisp_h_XCDR, lisp_h_XCONS, lisp_h_XHASH) + (lisp_h_XPNTR, lisp_h_XSYMBOL): + New macros, renamed from their sans-lisp_h_ counterparts. + (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL) + (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, LISP_INT_TAG_P, MARKERP) + (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) + (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): + If compiling via GCC without optimization, define these as macros + in addition to inline functions. + To disable this, compile with -DINLINING=0. + (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise. + (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but + hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. + (INTMASK, VALMASK): Now macros, since static values cannot be + accessed from extern inline functions. + (VALMASK): Also a constant, for benefit of old GDB. + (LISP_INT_TAG_P, XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) + (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) + (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) + (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) + (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) + (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET) + (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF) + (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) + (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS) + (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) + (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) + (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) + (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE) + (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE) + (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE) + (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) + (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) + (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) + (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) + (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP) + (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP) + (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) + (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) + (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) + (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) + (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) + (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) + (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) + (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) + (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) + (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) + (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) + Now functions. + (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. + (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed. + (VALMASK): Define in one place rather than in two, merging the + USE_LSB_TAG parts; this is simpler. + (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM) + (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): + Move up, to avoid use before definition. + Also include "globals.h" earlier, for the same reason. + (make_natnum): New function. + (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. + (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) + (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) + (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) + (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) + (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) + (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) + (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) + (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) + (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) + (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) + (Qwindow_configuration_p, Qimage): New forward declarations. + (XSETFASTINT): Simplify by rewriting in terms of make_natnum. + (STRING_COPYIN): Remove; unused. + (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ... + (xcar_addr, xcdr_addr): New functions. All uses changed. + (IEEE_FLOATING_POINT): Now a constant, not a macro. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. + (TYPE_RANGED_INTEGERP): Simplify. + (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. + (setlocale, fixup_locale, synchronize_system_messages_locale) + (synchronize_system_time_locale) [!HAVE_SETLOCALE]: + Now empty functions, not macros. + (functionp): Return bool, not int. + * window.c (Qwindow_configuration_p): Now extern, + so window.h can use it. + * window.h (Qwindowp): Move decl back to lisp.h. + 2013-06-13 Kelly Dean (tiny change) * fileio.c (Fdo_auto_save): Trap errors in auto-save-hook. (Bug#14479) === modified file 'src/alloc.c' --- src/alloc.c 2013-06-03 09:01:53 +0000 +++ src/alloc.c 2013-06-09 19:42:53 +0000 @@ -3309,7 +3309,7 @@ --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; - XMISCTYPE (val) = type; + XMISCANY (val)->type = type; XMISCANY (val)->gcmarkbit = 0; return val; } @@ -3319,7 +3319,7 @@ void free_misc (Lisp_Object misc) { - XMISCTYPE (misc) = Lisp_Misc_Free; + XMISCANY (misc)->type = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); consing_since_gc -= sizeof (union Lisp_Misc); @@ -5647,7 +5647,7 @@ { CONS_MARK (XCONS (tail)); mark_object (XCAR (tail)); - prev = &XCDR_AS_LVALUE (tail); + prev = xcdr_addr (tail); } } mark_object (tail); @@ -6689,8 +6689,5 @@ enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; -#if USE_LSB_TAG - enum lsb_bits lsb_bits; -#endif } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ === modified file 'src/buffer.c' --- src/buffer.c 2013-05-07 14:12:57 +0000 +++ src/buffer.c 2013-06-09 19:42:53 +0000 @@ -134,7 +134,7 @@ static Lisp_Object Qget_file_buffer; -static Lisp_Object Qoverlayp; +Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; === modified file 'src/data.c' --- src/data.c 2013-06-03 18:29:30 +0000 +++ src/data.c 2013-06-12 23:41:54 +0000 @@ -76,7 +76,8 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -static Lisp_Object Qsubrp, Qmany, Qunevalled; +Lisp_Object Qsubrp; +static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; === modified file 'src/dispextern.h' --- src/dispextern.h 2013-06-08 18:28:36 +0000 +++ src/dispextern.h 2013-06-09 19:42:53 +0000 @@ -22,6 +22,8 @@ #ifndef DISPEXTERN_H_INCLUDED #define DISPEXTERN_H_INCLUDED +#include "character.h" + #ifdef HAVE_X_WINDOWS #include @@ -270,6 +272,55 @@ Glyphs ***********************************************************************/ +/* The glyph datatype, used to represent characters on the display. + It consists of a char code and a face id. */ + +typedef struct { + int ch; + int face_id; +} GLYPH; + +/* Return a glyph's character code. */ +DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } + +/* Return a glyph's face ID. */ +DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } + +#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) +#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) +#define SET_GLYPH(glyph, char, face) \ + ((glyph).ch = (char), (glyph).face_id = (face)) + +/* The following are valid only if GLYPH_CODE_P (gc). */ + +DISPEXTERN_INLINE int +GLYPH_CODE_CHAR (Lisp_Object gc) +{ + return (CONSP (gc) + ? XINT (XCAR (gc)) + : XINT (gc) & MAX_CHAR); +} + +DISPEXTERN_INLINE int +GLYPH_CODE_FACE (Lisp_Object gc) +{ + return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; +} + +#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ + do \ + { \ + if (CONSP (gc)) \ + SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + else \ + SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ + (XINT (gc) >> CHARACTERBITS)); \ + } \ + while (0) + +/* The ID of the mode line highlighting face. */ +enum { GLYPH_MODE_LINE_FACE = 1 }; + /* Enumeration of glyph types. Glyph structures contain a type field containing one of the enumerators defined here. */ @@ -1774,6 +1825,30 @@ #endif /* not HAVE_WINDOW_SYSTEM */ +/* Return true if G contains a valid character code. */ +DISPEXTERN_INLINE bool +GLYPH_CHAR_VALID_P (GLYPH g) +{ + return CHAR_VALID_P (GLYPH_CHAR (g)); +} + +/* The glyph code from a display vector may either be an integer which + encodes a char code in the lower CHARACTERBITS bits and a (very small) + face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ + +DISPEXTERN_INLINE bool +GLYPH_CODE_P (Lisp_Object gc) +{ + return (CONSP (gc) + ? (CHARACTERP (XCAR (gc)) + && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_INTEGERP + (0, gc, + (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR + : TYPE_MAXIMUM (EMACS_INT))))); +} + /* Non-zero means face attributes have been changed since the last redisplay. Used in redisplay_internal. */ === modified file 'src/fns.c' --- src/fns.c 2013-04-08 18:04:58 +0000 +++ src/fns.c 2013-06-12 23:42:10 +0000 @@ -3335,7 +3335,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; +Lisp_Object Qhash_table_p; +static Lisp_Object Qkey, Qvalue, Qeql; Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; === modified file 'src/lisp.h' --- src/lisp.h 2013-06-05 12:17:02 +0000 +++ src/lisp.h 2013-06-13 00:06:53 +0000 @@ -220,6 +220,130 @@ #endif +/* Some operations are so commonly executed that they are implemented + as macros, not functions, because otherwise runtime performance would + suffer too much when compiling with GCC without optimization. + There's no need to inline everything, just the operations that + would otherwise cause a serious performance problem. + + For each such operation OP, define a macro lisp_h_OP that contains + the operation's implementation. That way, OP can be implementated + via a macro definition like this: + + #define OP(x) lisp_h_OP (x) + + and/or via a function definition like this: + + Lisp_Object + (OP) (Lisp_Object x) + { + return lisp_h_OP (x); + } + + without worrying about the implementations diverging, since + lisp_h_OP defines the actual implementation. The lisp_h_OP macros + are intended to be private to this include file, and should not be + used elsewhere. + + FIXME: Remove the lisp_h_OP macros, and define just the inline OP + functions, once most developers have access to GCC 4.8 or later and + can use "gcc -Og" to debug. Maybe in the year 2016. See + Bug#11935. + + Commentary for these macros can be found near their corresponding + functions, below. */ + +#if CHECK_LISP_OBJECT_TYPE +# define lisp_h_XLI(o) ((o).i) +# define lisp_h_XIL(i) ((Lisp_Object) { i }) +#else +# define lisp_h_XLI(o) (o) +# define lisp_h_XIL(i) (i) +#endif +#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) +#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) +#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) +#define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \ + ((void) ((ok) || wrong_type_argument (Qxxxp, x))) +#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) +#define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) +#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) +#define lisp_h_INTEGERP(x) LISP_INT_TAG_P (XTYPE (x)) +#define lisp_h_LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) +#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) +#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) +#define lisp_h_NILP(x) EQ (x, Qnil) +#define lisp_h_SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +#define lisp_h_SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) +#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) +#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +#define lisp_h_XCAR(c) XCONS (c)->car +#define lisp_h_XCDR(c) XCONS (c)->u.cdr +#define lisp_h_XCONS(a) \ + (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +#define lisp_h_XHASH(a) XUINT (a) +#define lisp_h_XPNTR(a) \ + ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) +#define lisp_h_XSYMBOL(a) \ + (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +#ifndef GC_CHECK_CONS_LIST +# define lisp_h_check_cons_list() ((void) 0) +#endif +#if USE_LSB_TAG +# define lisp_h_make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS) +# define lisp_h_XFASTINT(a) XINT (a) +# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) +# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) +# define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type))) +#endif + +/* When compiling via gcc -O0, define the key operations as macros, as + Emacs is too slow otherwise. To disable this optimization, compile + with -DINLINING=0. */ +#if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ + && ! (defined INLINING && ! INLINING)) +# define XLI(o) lisp_h_XLI (o) +# define XIL(i) lisp_h_XIL (i) +# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) +# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) +# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) +# define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x) +# define CONSP(x) lisp_h_CONSP (x) +# define EQ(x, y) lisp_h_EQ (x, y) +# define FLOATP(x) lisp_h_FLOATP (x) +# define INTEGERP(x) lisp_h_INTEGERP (x) +# define LISP_INT_TAG_P(x) lisp_h_LISP_INT_TAG_P (x) +# define MARKERP(x) lisp_h_MARKERP (x) +# define MISCP(x) lisp_h_MISCP (x) +# define NILP(x) lisp_h_NILP (x) +# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) +# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) +# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) +# define SYMBOLP(x) lisp_h_SYMBOLP (x) +# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) +# define XCAR(c) lisp_h_XCAR (c) +# define XCDR(c) lisp_h_XCDR (c) +# define XCONS(a) lisp_h_XCONS (a) +# define XHASH(a) lisp_h_XHASH (a) +# define XPNTR(a) lisp_h_XPNTR (a) +# define XSYMBOL(a) lisp_h_XSYMBOL (a) +# ifndef GC_CHECK_CONS_LIST +# define check_cons_list() lisp_h_check_cons_list () +# endif +# if USE_LSB_TAG +# define make_number(n) lisp_h_make_number (n) +# define XFASTINT(a) lisp_h_XFASTINT (a) +# define XINT(a) lisp_h_XINT (a) +# define XTYPE(a) lisp_h_XTYPE (a) +# define XUNTAG(a, type) lisp_h_XUNTAG (a, type) +# endif +#endif + + /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. If you want to define a new @@ -230,7 +354,6 @@ extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 -#define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, and xlc complains vociferously about them. */ @@ -270,6 +393,12 @@ Lisp_Float = 7, }; +LISP_INLINE bool +(LISP_INT_TAG_P) (int x) +{ + return lisp_h_LISP_INT_TAG_P (x); +} + /* This is the set of data types that share a common structure. The first member of the structure is a type code from this set. The enum values are arbitrary, but we'll use large numbers to make it @@ -359,20 +488,6 @@ typedef struct { EMACS_INT i; } Lisp_Object; -#define XLI(o) (o).i -LISP_INLINE Lisp_Object -XIL (EMACS_INT i) -{ - Lisp_Object o = { i }; - return o; -} - -LISP_INLINE Lisp_Object -LISP_MAKE_RVALUE (Lisp_Object o) -{ - return o; -} - #define LISP_INITIALLY_ZERO {0} #undef CHECK_LISP_OBJECT_TYPE @@ -382,13 +497,22 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -#define XLI(o) (o) -#define XIL(i) (i) -#define LISP_MAKE_RVALUE(o) (0 + (o)) #define LISP_INITIALLY_ZERO 0 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; #endif /* CHECK_LISP_OBJECT_TYPE */ +LISP_INLINE EMACS_INT +(XLI) (Lisp_Object o) +{ + return lisp_h_XLI (o); +} + +LISP_INLINE Lisp_Object +(XIL) (EMACS_INT i) +{ + return lisp_h_XIL (i); +} + /* In the size word of a vector, this bit means the vector has been marked. */ static ptrdiff_t const ARRAY_MARK_FLAG @@ -460,84 +584,119 @@ BOOL_VECTOR_BITS_PER_CHAR = 8 }; -/* These macros extract various sorts of values from a Lisp_Object. +/* These functions extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -#if USE_LSB_TAG - -enum lsb_bits - { - TYPEMASK = (1 << GCTYPEBITS) - 1, - VALMASK = ~ TYPEMASK - }; -#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) -#define XINT(a) (XLI (a) >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) -#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) -#define make_lisp_ptr(ptr, type) \ - (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ - XIL ((type) | (intptr_t) (ptr))) - -#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) -#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) - -#else /* not USE_LSB_TAG */ - static EMACS_INT const VALMASK -#define VALMASK VAL_MAX +#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) = VALMASK; -#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp integers have zero-bits in their tags. */ -#define XFASTINT(a) (XLI (a) + 0) -#define XSETFASTINT(a, b) ((a) = XIL (b)) - -/* Extract the value of a Lisp_Object as a (un)signed integer. */ - -#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) -#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) - -#define make_lisp_ptr(ptr, type) \ - (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object. */ -#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) - -#endif /* not USE_LSB_TAG */ +/* Largest and smallest representable fixnum values. These are the C + values. They are macros for use in static initializers. */ +#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) +#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) + +LISP_INLINE enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XTYPE (a); +#else + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; +#endif +} + +/* Extract the value of a Lisp_Object as a signed integer. */ +LISP_INLINE EMACS_INT +(XINT) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XINT (a); +#else + EMACS_INT i = XLI (a); + return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; +#endif +} + +/* Like XINT (A), but may be faster. A must be nonnegative. This takes + advantage of the fact that Lisp integers have zero-bits in their tags. */ +LISP_INLINE EMACS_INT +(XFASTINT) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XFASTINT (a); +#else + EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a); + eassert (0 <= n); + return n; +#endif +} + +/* Extract the value of a Lisp_Object as an unsigned integer. */ +LISP_INLINE EMACS_UINT +XUINT (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; +} /* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be like XUINT right now, but XUINT should only be applied to objects we know are integers. */ -#define XHASH(a) XUINT (a) +LISP_INLINE EMACS_INT +(XHASH) (Lisp_Object a) +{ + return lisp_h_XHASH (a); +} -/* For integers known to be positive, XFASTINT sometimes provides - faster retrieval and XSETFASTINT provides faster storage. - If not, fallback on the non-accelerated path. */ -#ifndef XFASTINT -# define XFASTINT(a) (XINT (a)) -# define XSETFASTINT(a, b) (XSETINT (a, b)) +LISP_INLINE Lisp_Object +(make_number) (EMACS_INT n) +{ +#if USE_LSB_TAG + return lisp_h_make_number (n); +#else + return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); #endif +} + +/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +LISP_INLINE Lisp_Object +make_natnum (EMACS_INT n) +{ + eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); + return USE_LSB_TAG ? make_number (n) : XIL (n); +} + +LISP_INLINE void * +(XPNTR) (Lisp_Object a) +{ + return lisp_h_XPNTR (a); +} /* Extract the pointer value of the Lisp object A, under the - assumption that A's type is TYPE. This is a fallback - implementation if nothing faster is available. */ -#ifndef XUNTAG -# define XUNTAG(a, type) XPNTR (a) + assumption that A's type is TYPE. */ +LISP_INLINE void * +(XUNTAG) (Lisp_Object a, int type) +{ +#if USE_LSB_TAG + return lisp_h_XUNTAG (a, type); +#else + if (USE_LSB_TAG) + { + intptr_t i = XLI (a) - type; + return (void *) i; + } + return XPNTR (a); #endif - -#define EQ(x, y) (XLI (x) == XLI (y)) - -/* Largest and smallest representable fixnum values. These are the C - values. They are macros for use in static initializers. */ -#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) -#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) +} + +LISP_INLINE bool +(EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_EQ (x, y); +} /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned @@ -551,66 +710,191 @@ { return num < lower ? lower : num <= upper ? num : upper; } - - + +/* Forward declarations. */ + +/* Defined in this file. */ +union Lisp_Fwd; +LISP_INLINE bool BOOLFWDP (union Lisp_Fwd *); +LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); +LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool BUFFERP (Lisp_Object); +LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); +LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); +LISP_INLINE bool (CONSP) (Lisp_Object); +LISP_INLINE bool (FLOATP) (Lisp_Object); +LISP_INLINE bool functionp (Lisp_Object); +LISP_INLINE bool (INTEGERP) (Lisp_Object); +LISP_INLINE bool INTFWDP (union Lisp_Fwd *); +LISP_INLINE bool KBOARD_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool (MARKERP) (Lisp_Object); +LISP_INLINE bool (MISCP) (Lisp_Object); +LISP_INLINE bool (NILP) (Lisp_Object); +LISP_INLINE bool OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool OVERLAYP (Lisp_Object); +LISP_INLINE bool PROCESSP (Lisp_Object); +LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); +LISP_INLINE bool SAVE_VALUEP (Lisp_Object); +LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, + Lisp_Object); +LISP_INLINE bool STRINGP (Lisp_Object); +LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); +LISP_INLINE bool SUBRP (Lisp_Object); +LISP_INLINE bool (SYMBOLP) (Lisp_Object); +LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); +LISP_INLINE bool WINDOWP (Lisp_Object); +LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + +/* Defined in buffer.c. */ +extern Lisp_Object Qoverlayp; + +/* Defined in chartab.c. */ +extern Lisp_Object char_table_ref (Lisp_Object, int); +extern void char_table_set (Lisp_Object, int, Lisp_Object); +extern int char_table_translate (Lisp_Object, int); + +/* Defined in data.c. */ +extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; +extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; +extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qvector_or_char_table_p, Qwholenump; +extern Lisp_Object Ffboundp (Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + +/* Defined in emacs.c. */ +extern bool initialized; + +/* Defined in eval.c. */ +extern Lisp_Object Qautoload; + +/* Defined in fns.c */ +extern Lisp_Object Qhash_table_p; + +/* Defined in floatfns.c. */ +extern double extract_float (Lisp_Object); + +/* Defined in process.c. */ +extern Lisp_Object Qprocessp; + +/* Defined in window.c. */ +extern Lisp_Object Qwindowp, Qwindow_configuration_p; + +/* Defined in xdisp.c. */ +extern Lisp_Object Qimage; + + /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) -#define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) - -/* Misc types. */ - -#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) -#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) -#define XMISCTYPE(a) (XMISCANY (a)->type) -#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) -#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) - -/* Forwarding object types. */ - -#define XFWDTYPE(a) (a->u_intfwd.type) -#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) -#define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) -#define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) +LISP_INLINE struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + return lisp_h_XCONS (a); +} + +LISP_INLINE struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + +LISP_INLINE struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ + return lisp_h_XSYMBOL (a); +} + +LISP_INLINE struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} /* Pseudovector types. */ -struct Lisp_Process; -LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) -{ return make_lisp_ptr (p, Lisp_Vectorlike); } -#define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) -#define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ - ((struct Lisp_Bool_Vector *) \ - XUNTAG (a, Lisp_Vectorlike))) + +LISP_INLINE struct Lisp_Process * +XPROCESS (Lisp_Object a) +{ + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct window * +XWINDOW (Lisp_Object a) +{ + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct terminal * +XTERMINAL (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct buffer * +XBUFFER (Lisp_Object a) +{ + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Sub_Char_Table * +XSUB_CHAR_TABLE (Lisp_Object a) +{ + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Bool_Vector * +XBOOL_VECTOR (Lisp_Object a) +{ + eassert (BOOL_VECTOR_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} /* Construct a Lisp_Object from a value or address. */ +LISP_INLINE Lisp_Object +make_lisp_ptr (void *ptr, enum Lisp_Type type) +{ + EMACS_UINT utype = type; + EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS; + Lisp_Object a = XIL (typebits | (uintptr_t) ptr); + eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); + return a; +} + +LISP_INLINE Lisp_Object +make_lisp_proc (struct Lisp_Process *p) +{ + return make_lisp_ptr (p, Lisp_Vectorlike); +} + #define XSETINT(a, b) ((a) = make_number (b)) +#define XSETFASTINT(a, b) ((a) = make_natnum (b)) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) @@ -656,35 +940,13 @@ #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -/* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -#define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) - -/* Convenience macros for dealing with Lisp strings. */ - -#define SDATA(string) (XSTRING (string)->data + 0) -#define SREF(string, index) (SDATA (string)[index] + 0) -#define SSET(string, index, new) (SDATA (string)[index] = (new)) -#define SCHARS(string) (XSTRING (string)->size + 0) -#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - -/* Avoid "differ in sign" warnings. */ -#define SSDATA(x) ((char *) SDATA (x)) - -#define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - -#define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ -#define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) +LISP_INLINE void +(CHECK_TYPE) (int ok, Lisp_Object Qxxxp, Lisp_Object x) +{ + lisp_h_CHECK_TYPE (ok, Qxxxp, x); +} /* Deprecated and will be removed soon. */ @@ -695,8 +957,11 @@ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type. */ -#define CHECK_STRING_OR_BUFFER(x) \ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) +LISP_INLINE void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} struct Lisp_Cons { @@ -714,64 +979,94 @@ }; /* Take the car or cdr of something known to be a cons cell. */ -/* The _AS_LVALUE macros shouldn't be used outside of the minimal set +/* The _addr functions shouldn't be used outside of the minimal set of code that has to know what a cons cell looks like. Other code not part of the basic lisp implementation should assume that the car and cdr - fields are not accessible as lvalues. (What if we want to switch to + fields are not accessible. (What if we want to switch to a copying collector someday? Cached cons cell field addresses may be invalidated at arbitrary points.) */ -#define XCAR_AS_LVALUE(c) (XCONS (c)->car) -#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) +LISP_INLINE Lisp_Object * +xcar_addr (Lisp_Object c) +{ + return &XCONS (c)->car; +} +LISP_INLINE Lisp_Object * +xcdr_addr (Lisp_Object c) +{ + return &XCONS (c)->u.cdr; +} /* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) +LISP_INLINE Lisp_Object +(XCAR) (Lisp_Object c) +{ + return lisp_h_XCAR (c); +} +LISP_INLINE Lisp_Object +(XCDR) (Lisp_Object c) +{ + return lisp_h_XCDR (c); +} /* Use these to set the fields of a cons cell. Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR(c) \ - (CONSP ((c)) ? XCAR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -#define CDR(c) \ - (CONSP ((c)) ? XCDR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR_SAFE(c) \ - (CONSP ((c)) ? XCAR ((c)) : Qnil) - -#define CDR_SAFE(c) \ - (CONSP ((c)) ? XCDR ((c)) : Qnil) + should not be read after 'c' is first modified. */ +LISP_INLINE void +XSETCAR (Lisp_Object c, Lisp_Object n) +{ + *xcar_addr (c) = n; +} +LISP_INLINE void +XSETCDR (Lisp_Object c, Lisp_Object n) +{ + *xcdr_addr (c) = n; +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR (Lisp_Object c) +{ + return (CONSP (c) ? XCAR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} +LISP_INLINE Lisp_Object +CDR (Lisp_Object c) +{ + return (CONSP (c) ? XCDR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCAR (c) : Qnil; +} +LISP_INLINE Lisp_Object +CDR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCDR (c) : Qnil; +} + +/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; /* True if STR is a multibyte string. */ -#define STRING_MULTIBYTE(STR) \ - (XSTRING (STR)->size_byte >= 0) - -/* Return the length in bytes of STR. */ - -#ifdef GC_CHECK_STRING_BYTES - -struct Lisp_String; -extern ptrdiff_t string_bytes (struct Lisp_String *); -#define STRING_BYTES(S) string_bytes ((S)) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define STRING_BYTES(STR) \ - ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) - -#endif /* not GC_CHECK_STRING_BYTES */ +LISP_INLINE bool +STRING_MULTIBYTE (Lisp_Object str) +{ + return 0 <= XSTRING (str)->size_byte; +} /* An upper bound on the number of bytes in a Lisp string, not counting the terminating null. This a tight enough bound to @@ -802,20 +1097,65 @@ (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ +/* Convenience functions for dealing with Lisp strings. */ -struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; +LISP_INLINE unsigned char * +SDATA (Lisp_Object string) +{ + return XSTRING (string)->data; +} +LISP_INLINE char * +SSDATA (Lisp_Object string) +{ + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); +} +LISP_INLINE unsigned char +SREF (Lisp_Object string, ptrdiff_t index) +{ + return SDATA (string)[index]; +} +LISP_INLINE void +SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) +{ + SDATA (string)[index] = new; +} +LISP_INLINE ptrdiff_t +SCHARS (Lisp_Object string) +{ + return XSTRING (string)->size; +} +LISP_INLINE ptrdiff_t +STRING_BYTES (struct Lisp_String *s) +{ +#ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + return string_bytes (s); +#else + return s->size_byte < 0 ? s->size : s->size_byte; +#endif +} +LISP_INLINE ptrdiff_t +SBYTES (Lisp_Object string) +{ + return STRING_BYTES (XSTRING (string)); +} +LISP_INLINE void +STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) +{ + XSTRING (string)->size = newsize; +} +LISP_INLINE void +STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, + ptrdiff_t count) +{ + memcpy (SDATA (string) + index, new, count); +} /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See . */ @@ -874,6 +1214,42 @@ word_size = sizeof (Lisp_Object) }; +/* Conveniences for dealing with Lisp arrays. */ + +LISP_INLINE Lisp_Object +AREF (Lisp_Object array, ptrdiff_t idx) +{ + return XVECTOR (array)->contents[idx]; +} + +LISP_INLINE Lisp_Object * +aref_addr (Lisp_Object array, ptrdiff_t idx) +{ + return & XVECTOR (array)->contents[idx]; +} + +LISP_INLINE ptrdiff_t +ASIZE (Lisp_Object array) +{ + return XVECTOR (array)->header.size; +} + +LISP_INLINE void +ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + eassert (0 <= idx && idx < ASIZE (array)); + XVECTOR (array)->contents[idx] = val; +} + +LISP_INLINE void +gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + /* Like ASET, but also can be used in the garbage collector: + sweep_weak_table calls set_hash_key etc. while the table is marked. */ + eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); + XVECTOR (array)->contents[idx] = val; +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ @@ -887,43 +1263,6 @@ #define PSEUDOVECSIZE(type, nonlispfield) \ ((offsetof (type, nonlispfield) - header_size) / word_size) -/* A char-table is a kind of vectorlike, with contents are like a - vector but with a few other slots. For some purposes, it makes - sense to handle a char-table with type struct Lisp_Vector. An - element of a char table can be any Lisp objects, but if it is a sub - char-table, we treat it a table that contains information of a - specific range of characters. A sub char-table has the same - structure as a vector. A sub char table appears only in an element - of a char-table, and there's no way to access it directly from - Emacs Lisp program. */ - -#ifdef __GNUC__ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - ({struct Lisp_Char_Table *_tbl = NULL; \ - Lisp_Object _val; \ - do { \ - _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ - _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ - : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ - if (NILP (_val)) \ - _val = _tbl->defalt; \ - } while (NILP (_val) && ! NILP (_tbl->parent)); \ - _val; }) - -#else /* not __GNUC__ */ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - (! NILP (XCHAR_TABLE (CT)->ascii) \ - ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XCHAR_TABLE (CT)->ascii \ - : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ - : char_table_ref ((CT), (IDX))) \ - : char_table_ref ((CT), (IDX))) - -#endif /* not __GNUC__ */ - /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) @@ -937,18 +1276,15 @@ /* Nonzero iff C is an ASCII character. */ #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - characters. Do not check validity of CT. */ -#define CHAR_TABLE_REF(CT, IDX) \ - (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ - : char_table_ref ((CT), (IDX))) - -/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit European characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \ - : char_table_set (CT, IDX, VAL)) +/* A char-table is a kind of vectorlike, with contents are like a + vector but with a few other slots. For some purposes, it makes + sense to handle a char-table with type struct Lisp_Vector. An + element of a char table can be any Lisp objects, but if it is a sub + char-table, we treat it a table that contains information of a + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ enum CHARTAB_SIZE_BITS { @@ -1012,6 +1348,45 @@ Lisp_Object contents[1]; }; +LISP_INLINE Lisp_Object +CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) +{ + struct Lisp_Char_Table *tbl = NULL; + Lisp_Object val; + do + { + tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); + val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii + : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + if (NILP (val)) + val = tbl->defalt; + } + while (NILP (val) && ! NILP (tbl->parent)); + + return val; +} + +/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII + characters. Do not check validity of CT. */ +LISP_INLINE Lisp_Object +CHAR_TABLE_REF (Lisp_Object ct, int idx) +{ + return (ASCII_CHAR_P (idx) + ? CHAR_TABLE_REF_ASCII (ct, idx) + : char_table_ref (ct, idx)); +} + +/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and + 8-bit European characters. Do not check validity of CT. */ +LISP_INLINE void +CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) +{ + if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) + set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val); + else + char_table_set (ct, idx, val); +} + /* This structure describes a built-in function. It is generated by the DEFUN macro only. defsubr makes it into a Lisp object. */ @@ -1048,8 +1423,12 @@ /* Return the number of "extra" slots in the char table CT. */ -#define CHAR_TABLE_EXTRA_SLOTS(CT) \ - (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) +LISP_INLINE int +CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) +{ + return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) + - CHAR_TABLE_STANDARD_SLOTS); +} /*********************************************************************** @@ -1121,40 +1500,84 @@ /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) -#define SYMBOL_ALIAS(sym) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) - -#define SYMBOL_NAME(sym) XSYMBOL (sym)->name - -/* Value is non-zero if SYM is an interned symbol. */ - -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) - -/* Value is non-zero if SYM is interned in initial_obarray. */ - -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +LISP_INLINE Lisp_Object +(SYMBOL_VAL) (struct Lisp_Symbol *sym) +{ + return lisp_h_SYMBOL_VAL (sym); +} +LISP_INLINE struct Lisp_Symbol * +SYMBOL_ALIAS (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + return sym->val.alias; +} +LISP_INLINE struct Lisp_Buffer_Local_Value * +SYMBOL_BLV (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + return sym->val.blv; +} +LISP_INLINE union Lisp_Fwd * +SYMBOL_FWD (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + return sym->val.fwd; +} +LISP_INLINE void +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +{ + lisp_h_SET_SYMBOL_VAL (sym, v); +} +LISP_INLINE void +SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + sym->val.alias = v; +} +LISP_INLINE void +SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + sym->val.blv = v; +} +LISP_INLINE void +SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + sym->val.fwd = v; +} + +LISP_INLINE Lisp_Object +SYMBOL_NAME (Lisp_Object sym) +{ + return XSYMBOL (sym)->name; +} + +/* Value is true if SYM is an interned symbol. */ + +LISP_INLINE bool +SYMBOL_INTERNED_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; +} + +/* Value is true if SYM is interned in initial_obarray. */ + +LISP_INLINE bool +SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; +} /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +LISP_INLINE int +(SYMBOL_CONSTANT_P) (Lisp_Object sym) +{ + return lisp_h_SYMBOL_CONSTANT_P (sym); +} #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1240,42 +1663,69 @@ }; -#define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) +LISP_INLINE struct Lisp_Hash_Table * +XHASH_TABLE (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) - -#define CHECK_HASH_TABLE(x) \ - CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) +LISP_INLINE bool +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} +LISP_INLINE void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} /* Value is the key part of entry IDX in hash table H. */ - -#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) +LISP_INLINE Lisp_Object +HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx); +} /* Value is the value part of entry IDX in hash table H. */ - -#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) +LISP_INLINE Lisp_Object +HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx + 1); +} /* Value is the index of the next entry following the one at IDX in hash table H. */ - -#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) +LISP_INLINE Lisp_Object +HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->next, idx); +} /* Value is the hash code computed for entry IDX in hash table H. */ - -#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) +LISP_INLINE Lisp_Object +HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->hash, idx); +} /* Value is the index of the element in hash table H that is the start of the collision list at index IDX in the index vector of H. */ - -#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) +LISP_INLINE Lisp_Object +HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->index, idx); +} /* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) +LISP_INLINE ptrdiff_t +HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) +{ + return ASIZE (h->next); +} /* Default size for hash tables if not specified. */ @@ -1485,6 +1935,53 @@ } data[SAVE_VALUE_SLOTS]; }; +/* Return the type of V's Nth saved value. */ +LISP_INLINE int +save_type (struct Lisp_Save_Value *v, int n) +{ + eassert (0 <= n && n < SAVE_VALUE_SLOTS); + return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); +} + +/* Get and set the Nth saved pointer. */ + +LISP_INLINE void * +XSAVE_POINTER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + return XSAVE_VALUE (obj)->data[n].pointer;; +} +LISP_INLINE void +set_save_pointer (Lisp_Object obj, int n, void *val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + XSAVE_VALUE (obj)->data[n].pointer = val; +} + +/* Likewise for the saved integer. */ + +LISP_INLINE ptrdiff_t +XSAVE_INTEGER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + return XSAVE_VALUE (obj)->data[n].integer; +} +LISP_INLINE void +set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + XSAVE_VALUE (obj)->data[n].integer = val; +} + +/* Extract Nth saved object. */ + +LISP_INLINE Lisp_Object +XSAVE_OBJECT (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); + return XSAVE_VALUE (obj)->data[n].object; +} + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -1506,6 +2003,46 @@ struct Lisp_Save_Value u_save_value; }; +LISP_INLINE union Lisp_Misc * +XMISC (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Misc); +} + +LISP_INLINE struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return & XMISC (a)->u_any; +} + +LISP_INLINE enum Lisp_Misc_Type +XMISCTYPE (Lisp_Object a) +{ + return XMISCANY (a)->type; +} + +LISP_INLINE struct Lisp_Marker * +XMARKER (Lisp_Object a) +{ + eassert (MARKERP (a)); + return & XMISC (a)->u_marker; +} + +LISP_INLINE struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) +{ + eassert (OVERLAYP (a)); + return & XMISC (a)->u_overlay; +} + +LISP_INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1612,6 +2149,47 @@ struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; + +LISP_INLINE enum Lisp_Fwd_Type +XFWDTYPE (union Lisp_Fwd *a) +{ + return a->u_intfwd.type; +} + +LISP_INLINE struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} + +LISP_INLINE struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} + +LISP_INLINE struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +LISP_INLINE struct Lisp_Buffer_Objfwd * +XBUFFER_OBJFWD (union Lisp_Fwd *a) +{ + eassert (BUFFER_OBJFWDP (a)); + return &a->u_buffer_objfwd; +} + +LISP_INLINE struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} /* Lisp floating point type. */ struct Lisp_Float @@ -1623,8 +2201,17 @@ } u; }; -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) -#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) +LISP_INLINE double +XFLOAT_DATA (Lisp_Object f) +{ + return XFLOAT (f)->u.data; +} + +LISP_INLINE void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on @@ -1633,8 +2220,12 @@ wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) +enum + { + IEEE_FLOATING_POINT + = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) + }; /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ @@ -1675,64 +2266,6 @@ itself. */ CHARACTERBITS = 22 }; - - - - -/* The glyph datatype, used to represent characters on the display. - It consists of a char code and a face id. */ - -typedef struct { - int ch; - int face_id; -} GLYPH; - -/* Return a glyph's character code. */ -#define GLYPH_CHAR(glyph) ((glyph).ch) - -/* Return a glyph's face ID. */ -#define GLYPH_FACE(glyph) ((glyph).face_id) - -#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) -#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) -#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) - -/* Return 1 if GLYPH contains valid character code. */ -#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) - - -/* Glyph Code from a display vector may either be an integer which - encodes a char code in the lower CHARACTERBITS bits and a (very small) - face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ - -#define GLYPH_CODE_P(gc) \ - (CONSP (gc) \ - ? (CHARACTERP (XCAR (gc)) \ - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ - : (RANGED_INTEGERP \ - (0, gc, \ - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ - ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ - : TYPE_MAXIMUM (EMACS_INT))))) - -/* The following are valid only if GLYPH_CODE_P (gc). */ - -#define GLYPH_CODE_CHAR(gc) \ - (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) - -#define GLYPH_CODE_FACE(gc) \ - (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) - -#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ - do \ - { \ - if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ - else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ - } \ - while (0) /* Structure to hold mouse highlight data. This is here because other header files need it for defining struct x_output etc. */ @@ -1768,190 +2301,321 @@ /* Data type checking. */ -#define NILP(x) EQ (x, Qnil) - -#define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) - -#define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) +LISP_INLINE bool +(NILP) (Lisp_Object x) +{ + return lisp_h_NILP (x); +} + +LISP_INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x); +} +LISP_INLINE bool +NATNUMP (Lisp_Object x) +{ + return INTEGERP (x) && 0 <= XINT (x); +} + +LISP_INLINE bool +RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +{ + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; +} + #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - -#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) -#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - -#define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) -#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) - + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + +LISP_INLINE bool +(CONSP) (Lisp_Object x) +{ + return lisp_h_CONSP (x); +} +LISP_INLINE bool +(FLOATP) (Lisp_Object x) +{ + return lisp_h_FLOATP (x); +} +LISP_INLINE bool +(MISCP) (Lisp_Object x) +{ + return lisp_h_MISCP (x); +} +LISP_INLINE bool +STRINGP (Lisp_Object x) +{ + return XTYPE (x) == Lisp_String; +} +LISP_INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return lisp_h_SYMBOLP (x); +} +LISP_INLINE bool +(INTEGERP) (Lisp_Object x) +{ + return lisp_h_INTEGERP (x); +} +LISP_INLINE bool +(VECTORLIKEP) (Lisp_Object x) +{ + return lisp_h_VECTORLIKEP (x); +} +LISP_INLINE bool +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} +LISP_INLINE bool +OVERLAYP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; +} +LISP_INLINE bool +(MARKERP) (Lisp_Object x) +{ + return lisp_h_MARKERP (x); +} LISP_INLINE bool SAVE_VALUEP (Lisp_Object x) { return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; } -LISP_INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; -} - -/* Return the type of V's Nth saved value. */ -LISP_INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -LISP_INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer;; -} -LISP_INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} - -/* Likewise for the saved integer. */ - -LISP_INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -LISP_INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -LISP_INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - -#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) - -#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) -#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) -#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) -#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) -#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - -/* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ -#define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) - -#define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) - -/* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ -#define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) +LISP_INLINE bool +AUTOLOADP (Lisp_Object x) +{ + return CONSP (x) && EQ (Qautoload, XCAR (x)); +} + +LISP_INLINE bool +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +LISP_INLINE bool +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +LISP_INLINE bool +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} +LISP_INLINE bool +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} +LISP_INLINE bool +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} + +LISP_INLINE bool +PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) +{ + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +LISP_INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } +} + /* Test for specific pseudovector types. */ -#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) -#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) + +LISP_INLINE bool +WINDOW_CONFIGURATIONP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); +} + +LISP_INLINE bool +PROCESSP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_PROCESS); +} + +LISP_INLINE bool +WINDOWP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW); +} + +LISP_INLINE bool +TERMINALP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TERMINAL); +} + +LISP_INLINE bool +SUBRP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUBR); +} + +LISP_INLINE bool +COMPILEDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_COMPILED); +} + +LISP_INLINE bool +BUFFERP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BUFFER); +} + +LISP_INLINE bool +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +LISP_INLINE bool +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); +} + +LISP_INLINE bool +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +LISP_INLINE bool +FRAMEP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_FRAME); +} /* Test for image (image . spec) */ -#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +LISP_INLINE bool +IMAGEP (Lisp_Object x) +{ + return CONSP (x) && EQ (XCAR (x), Qimage); +} /* Array types. */ - -#define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) +LISP_INLINE bool +ARRAYP (Lisp_Object x) +{ + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); +} -#define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - -#define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - -#define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - -#define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - -#define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - -#define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - -#define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - -#define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - -#define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - -#define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - -#define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - -#define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - -#define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - -#define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - -#define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - -#define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) - -#define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) - -#define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) +LISP_INLINE void +CHECK_LIST (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); +} +LISP_INLINE void +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +{ + lisp_h_CHECK_LIST_CONS (x, y); +} +LISP_INLINE void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} +LISP_INLINE void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} +LISP_INLINE void +CHECK_STRING_CAR (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); +} +LISP_INLINE void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} +LISP_INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} +LISP_INLINE void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} +LISP_INLINE void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_STRING (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); +} +LISP_INLINE void +CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +{ + CHECK_TYPE (ARRAYP (x), Qxxxp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} +LISP_INLINE void +CHECK_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (BUFFERP (x), Qbufferp, x); +} +LISP_INLINE void +CHECK_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x), Qwindowp, x); +} +LISP_INLINE void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} +LISP_INLINE void +CHECK_PROCESS (Lisp_Object x) +{ + CHECK_TYPE (PROCESSP (x), Qprocessp, x); +} +LISP_INLINE void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} +LISP_INLINE void +(CHECK_NUMBER) (Lisp_Object x) +{ + lisp_h_CHECK_NUMBER (x); +} +LISP_INLINE void +CHECK_NATNUM (Lisp_Object x) +{ + CHECK_TYPE (NATNUMP (x), Qwholenump, x); +} #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@ -1972,57 +2636,76 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -#define CHECK_MARKER(x) \ - CHECK_TYPE (MARKERP (x), Qmarkerp, x) +LISP_INLINE void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) -#define XFLOATINT(n) extract_float((n)) - -#define CHECK_FLOAT(x) \ - CHECK_TYPE (FLOATP (x), Qfloatp, x) - -#define CHECK_NUMBER_OR_FLOAT(x) \ - CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) +LISP_INLINE double +XFLOATINT (Lisp_Object n) +{ + return extract_float (n); +} + +LISP_INLINE void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} +LISP_INLINE void +CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); +} #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -#define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) +LISP_INLINE void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ -#define CHECK_NUMBER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) +LISP_INLINE void +CHECK_NUMBER_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NUMBER_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2088,8 +2771,12 @@ #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* Non-zero if OBJ is a Lisp function. */ -#define FUNCTIONP(OBJ) functionp(OBJ) +/* True if OBJ is a Lisp function. */ +LISP_INLINE bool +FUNCTIONP (Lisp_Object obj) +{ + return functionp (obj); +} /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ @@ -2276,7 +2963,11 @@ extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +LISP_INLINE ptrdiff_t +SPECPDL_INDEX (void) +{ + return specpdl_ptr - specpdl; +} /* Everything needed to describe an active condition case. @@ -2592,27 +3283,12 @@ #define EXFUN(fnname, maxargs) \ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs +#include "globals.h" + /* Forward declarations for prototypes. */ struct window; struct frame; -/* Simple access functions. */ - -LISP_INLINE Lisp_Object * -aref_addr (Lisp_Object array, ptrdiff_t idx) -{ - return & XVECTOR (array)->contents[idx]; -} - -LISP_INLINE void -gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) -{ - /* Like ASET, but also can be used in the garbage collector: - sweep_weak_table calls set_hash_key etc. while the table is marked. */ - eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); - XVECTOR (array)->contents[idx] = val; -} - /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ LISP_INLINE void @@ -2849,6 +3525,7 @@ extern Lisp_Object Qbuffer, Qinteger, Qsymbol; +extern Lisp_Object Qsubrp; extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; @@ -3237,7 +3914,7 @@ #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); #else -#define check_cons_list() ((void) 0) +LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } #endif #ifdef REL_ALLOC @@ -3305,10 +3982,12 @@ extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); -#define LOADHIST_ATTACH(x) \ - do { \ - if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ - } while (0) +LISP_INLINE void +LOADHIST_ATTACH (Lisp_Object x) +{ + if (initialized) + Vcurrent_load_list = Fcons (x, Vcurrent_load_list); +} extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object); extern Lisp_Object string_to_number (char const *, int, bool); @@ -3431,6 +4110,7 @@ extern Lisp_Object Vbuffer_alist; extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); +extern Lisp_Object Qoverlayp; extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); extern void init_buffer_once (void); @@ -3594,10 +4274,10 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -#define setlocale(category, locale) -#define fixup_locale() -#define synchronize_system_messages_locale() -#define synchronize_system_time_locale() +LISP_INLINE char *setlocale (int cat, char const *locale) { return 0; } +LISP_INLINE void fixup_locale (void) {} +LISP_INLINE void synchronize_system_messages_locale (void) {} +LISP_INLINE void synchronize_system_time_locale (void) {} #endif extern void shut_down_emacs (int, Lisp_Object); @@ -3956,8 +4636,6 @@ } while (0) -#include "globals.h" - /* Check whether it's time for GC, and run it if so. */ LISP_INLINE void @@ -3970,7 +4648,7 @@ Fgarbage_collect (); } -LISP_INLINE int +LISP_INLINE bool functionp (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) === modified file 'src/window.c' --- src/window.c 2013-06-04 16:33:46 +0000 +++ src/window.c 2013-06-09 19:42:53 +0000 @@ -55,7 +55,8 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_valid_p; -static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; +Lisp_Object Qwindow_configuration_p; +static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; === modified file 'src/window.h' --- src/window.h 2013-03-28 14:04:49 +0000 +++ src/window.h 2013-06-09 19:42:53 +0000 @@ -958,7 +958,7 @@ /* These used to be in lisp.h. */ -extern Lisp_Object Qwindowp, Qwindow_live_p; +extern Lisp_Object Qwindow_live_p; extern Lisp_Object Vwindow_list; extern struct window *decode_live_window (Lisp_Object);