aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2013-06-16 23:03:19 -0700
committerPaul Eggert2013-06-16 23:03:19 -0700
commit84575e67fc390815f8f9fc8bea095e006f0890c4 (patch)
treea3285603fbe57ecfd7c12b1cfef0f1b431530965 /src
parentf612933b88509427a690ea1966eac533b8ef80e1 (diff)
downloademacs-84575e67fc390815f8f9fc8bea095e006f0890c4.tar.gz
emacs-84575e67fc390815f8f9fc8bea095e006f0890c4.zip
Use functions, not macros, for XINT etc.
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. Also, move functions from lisp.h to individual modules when possible. From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>. * alloc.c (XFLOAT_INIT, set_symbol_name): * buffer.c (CHECK_OVERLAY): * chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii) (set_char_table_parent): * coding.c (CHECK_NATNUM_CAR, CHECK_NATNUM_CDR): * data.c (BOOLFWDP, INTFWDP, KBOARD_OBJFWDP, OBJFWDP, XBOOLFWD) (XKBOARD_OBJFWD, XINTFWD, XOBJFWD, CHECK_SUBR, set_blv_found) (blv_value, set_blv_value, set_blv_where, set_blv_defcell) (set_blv_valcell): * emacs.c (setlocale) [!HAVE_SETLOCALE]: * eval.c (specpdl_symbol, specpdl_old_value, specpdl_where) (specpdl_arg, specpdl_func, backtrace_function, backtrace_nargs) (backtrace_args, backtrace_debug_on_exit): * floatfns.c (CHECK_FLOAT): * fns.c (CHECK_HASH_TABLE, CHECK_LIST_END) (set_hash_key_and_value, set_hash_next, set_hash_next_slot) (set_hash_hash, set_hash_hash_slot, set_hash_index) (set_hash_index_slot): * keymap.c (CHECK_VECTOR_OR_CHAR_TABLE): * marker.c (CHECK_MARKER): * textprop.c (CHECK_STRING_OR_BUFFER): * window.c (CHECK_WINDOW_CONFIGURATION): Move here from lisp.h, and make these functions static rather than extern inline. * buffer.c (Qoverlayp): * data.c (Qsubrp): * fns.c (Qhash_table_p): * window.c (Qwindow_configuration_p): Now static. * lisp.h: Remove the abovementioned defns and decls. * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, as it generates bogus warnings about reasonable casts of calls. * 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_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, 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. (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): New macros. (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): Remove; no longer needed as the only caller is INTEGERP, which can fold it in. (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.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog161
-rw-r--r--src/alloc.c20
-rw-r--r--src/buffer.c8
-rw-r--r--src/chartab.c16
-rw-r--r--src/coding.c16
-rw-r--r--src/data.c91
-rw-r--r--src/dispextern.h75
-rw-r--r--src/emacs.c7
-rw-r--r--src/eval.c63
-rw-r--r--src/floatfns.c8
-rw-r--r--src/fns.c51
-rw-r--r--src/keymap.c6
-rw-r--r--src/lisp.h1722
-rw-r--r--src/marker.c6
-rw-r--r--src/textprop.c8
-rw-r--r--src/window.c9
-rw-r--r--src/window.h2
17 files changed, 1565 insertions, 704 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index a26577c20a3..fc57bdaba26 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,164 @@
12013-06-17 Paul Eggert <eggert@cs.ucla.edu>
2
3 Move functions from lisp.h to individual modules when possible.
4 From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>.
5 * alloc.c (XFLOAT_INIT, set_symbol_name):
6 * buffer.c (CHECK_OVERLAY):
7 * chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii)
8 (set_char_table_parent):
9 * coding.c (CHECK_NATNUM_CAR, CHECK_NATNUM_CDR):
10 * data.c (BOOLFWDP, INTFWDP, KBOARD_OBJFWDP, OBJFWDP, XBOOLFWD)
11 (XKBOARD_OBJFWD, XINTFWD, XOBJFWD, CHECK_SUBR, set_blv_found)
12 (blv_value, set_blv_value, set_blv_where, set_blv_defcell)
13 (set_blv_valcell):
14 * emacs.c (setlocale) [!HAVE_SETLOCALE]:
15 * eval.c (specpdl_symbol, specpdl_old_value, specpdl_where)
16 (specpdl_arg, specpdl_func, backtrace_function, backtrace_nargs)
17 (backtrace_args, backtrace_debug_on_exit):
18 * floatfns.c (CHECK_FLOAT):
19 * fns.c (CHECK_HASH_TABLE, CHECK_LIST_END)
20 (set_hash_key_and_value, set_hash_next, set_hash_next_slot)
21 (set_hash_hash, set_hash_hash_slot, set_hash_index)
22 (set_hash_index_slot):
23 * keymap.c (CHECK_VECTOR_OR_CHAR_TABLE):
24 * marker.c (CHECK_MARKER):
25 * textprop.c (CHECK_STRING_OR_BUFFER):
26 * window.c (CHECK_WINDOW_CONFIGURATION):
27 Move here from lisp.h, and make these functions static rather than
28 extern inline.
29 * buffer.c (Qoverlayp):
30 * data.c (Qsubrp):
31 * fns.c (Qhash_table_p):
32 * window.c (Qwindow_configuration_p):
33 Now static.
34 * lisp.h: Remove the abovementioned defns and decls.
35
36 Use functions, not macros, for XINT etc. (Bug#11935).
37 In lisp.h, prefer functions to function-like macros, and
38 constants to object-like macros, when either will do. This:
39 . simplifies use, as there's no more need to worry about
40 arguments' side effects being evaluated multiple times.
41 . makes the code easier to debug on some platforms.
42 However, when using gcc -O0, keep using function-like macros
43 for a few critical operations, for performance reasons.
44 This sort of thing isn't needed with gcc -Og, but -Og
45 is a GCC 4.8 feature and isn't widely-enough available yet.
46 * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]:
47 Remove enum lsb_bits; no longer needed.
48 (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue.
49 * buffer.c (Qoverlap):
50 * data.c (Qsubrp):
51 * fns.c (Qhash_table_p):
52 Now extern, so lisp.h can use these symbols.
53 * dispextern.h: Include character.h, for MAX_CHAR etc.
54 (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE)
55 (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
56 (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P)
57 (GLYPH_CODE_P): Move here from lisp.h.
58 (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
59 (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros.
60 (GLYPH_MODE_LINE_FACE): Now enums, not macros.
61 * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since
62 XUNTAG now returns void *.
63 * lisp.h (lisp_h_XLI, lisp_h_XIL, lisp_h_CHECK_LIST_CONS)
64 (lisp_h_CHECK_NUMBER CHECK_SYMBOL, lisp_h_CHECK_TYPE)
65 (lisp_h_CONSP, lisp_h_EQ, lisp_h_FLOATP, lisp_h_INTEGERP)
66 (lisp_h_MARKERP, lisp_h_MISCP, lisp_h_NILP)
67 (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_CONSTANT_P)
68 (lisp_h_SYMBOL_VAL, lisp_h_SYMBOLP, lisp_h_VECTORLIKEP)
69 (lisp_h_XCAR, lisp_h_XCDR, lisp_h_XCONS, lisp_h_XHASH)
70 (lisp_h_XPNTR, lisp_h_XSYMBOL):
71 New macros, renamed from their sans-lisp_h_ counterparts.
72 (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL)
73 (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, MARKERP)
74 (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP)
75 (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL):
76 If compiling via GCC without optimization, define these as macros
77 in addition to inline functions.
78 To disable this, compile with -DINLINING=0.
79 (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): New macros.
80 (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise.
81 (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but
82 hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that.
83 (INTMASK, VALMASK): Now macros, since static values cannot be
84 accessed from extern inline functions.
85 (VALMASK): Also a constant, for benefit of old GDB.
86 (LISP_INT_TAG_P): Remove; no longer needed as the only caller
87 is INTEGERP, which can fold it in.
88 (XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT)
89 (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL)
90 (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE)
91 (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE)
92 (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR)
93 (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET)
94 (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF)
95 (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF)
96 (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS)
97 (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS)
98 (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P)
99 (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P)
100 (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE)
101 (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE)
102 (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE)
103 (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD)
104 (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP)
105 (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP)
106 (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP)
107 (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP)
108 (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP)
109 (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP)
110 (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P)
111 (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP)
112 (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING)
113 (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE)
114 (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY)
115 (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW)
116 (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR)
117 (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT)
118 (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY)
119 (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR)
120 (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH)
121 Now functions.
122 (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function.
123 (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed.
124 (VALMASK): Define in one place rather than in two, merging the
125 USE_LSB_TAG parts; this is simpler.
126 (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM)
127 (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P):
128 Move up, to avoid use before definition.
129 Also include "globals.h" earlier, for the same reason.
130 (make_natnum): New function.
131 (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts.
132 (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP)
133 (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP)
134 (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP)
135 (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP)
136 (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set)
137 (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p)
138 (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp)
139 (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp)
140 (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument)
141 (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp)
142 (Qwindow_configuration_p, Qimage): New forward declarations.
143 (XSETFASTINT): Simplify by rewriting in terms of make_natnum.
144 (STRING_COPYIN): Remove; unused.
145 (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ...
146 (xcar_addr, xcdr_addr): New functions. All uses changed.
147 (IEEE_FLOATING_POINT): Now a constant, not a macro.
148 (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE)
149 (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
150 (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P)
151 (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use.
152 (TYPE_RANGED_INTEGERP): Simplify.
153 (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls.
154 (setlocale, fixup_locale, synchronize_system_messages_locale)
155 (synchronize_system_time_locale) [!HAVE_SETLOCALE]:
156 Now empty functions, not macros.
157 (functionp): Return bool, not int.
158 * window.c (Qwindow_configuration_p): Now extern,
159 so window.h can use it.
160 * window.h (Qwindowp): Move decl back to lisp.h.
161
12013-06-15 Eli Zaretskii <eliz@gnu.org> 1622013-06-15 Eli Zaretskii <eliz@gnu.org>
2 163
3 * xdisp.c (Fline_pixel_height): New function, required for solving 164 * xdisp.c (Fline_pixel_height): New function, required for solving
diff --git a/src/alloc.c b/src/alloc.c
index cce0fff4fd4..3eb7e982e0f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -363,6 +363,11 @@ static void *pure_alloc (size_t, int);
363 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ 363 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
364 & ~ ((ALIGNMENT) - 1))) 364 & ~ ((ALIGNMENT) - 1)))
365 365
366static void
367XFLOAT_INIT (Lisp_Object f, double n)
368{
369 XFLOAT (f)->u.data = n;
370}
366 371
367 372
368/************************************************************************ 373/************************************************************************
@@ -3189,6 +3194,12 @@ static int symbol_block_index = SYMBOL_BLOCK_SIZE;
3189 3194
3190static struct Lisp_Symbol *symbol_free_list; 3195static struct Lisp_Symbol *symbol_free_list;
3191 3196
3197static void
3198set_symbol_name (Lisp_Object sym, Lisp_Object name)
3199{
3200 XSYMBOL (sym)->name = name;
3201}
3202
3192DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3203DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
3193 doc: /* Return a newly allocated uninterned symbol whose name is NAME. 3204 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
3194Its value is void, and its function definition and property list are nil. */) 3205Its value is void, and its function definition and property list are nil. */)
@@ -3309,7 +3320,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3309 --total_free_markers; 3320 --total_free_markers;
3310 consing_since_gc += sizeof (union Lisp_Misc); 3321 consing_since_gc += sizeof (union Lisp_Misc);
3311 misc_objects_consed++; 3322 misc_objects_consed++;
3312 XMISCTYPE (val) = type; 3323 XMISCANY (val)->type = type;
3313 XMISCANY (val)->gcmarkbit = 0; 3324 XMISCANY (val)->gcmarkbit = 0;
3314 return val; 3325 return val;
3315} 3326}
@@ -3319,7 +3330,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3319void 3330void
3320free_misc (Lisp_Object misc) 3331free_misc (Lisp_Object misc)
3321{ 3332{
3322 XMISCTYPE (misc) = Lisp_Misc_Free; 3333 XMISCANY (misc)->type = Lisp_Misc_Free;
3323 XMISC (misc)->u_free.chain = marker_free_list; 3334 XMISC (misc)->u_free.chain = marker_free_list;
3324 marker_free_list = XMISC (misc); 3335 marker_free_list = XMISC (misc);
3325 consing_since_gc -= sizeof (union Lisp_Misc); 3336 consing_since_gc -= sizeof (union Lisp_Misc);
@@ -5647,7 +5658,7 @@ mark_discard_killed_buffers (Lisp_Object list)
5647 { 5658 {
5648 CONS_MARK (XCONS (tail)); 5659 CONS_MARK (XCONS (tail));
5649 mark_object (XCAR (tail)); 5660 mark_object (XCAR (tail));
5650 prev = &XCDR_AS_LVALUE (tail); 5661 prev = xcdr_addr (tail);
5651 } 5662 }
5652 } 5663 }
5653 mark_object (tail); 5664 mark_object (tail);
@@ -6689,8 +6700,5 @@ union
6689 enum MAX_ALLOCA MAX_ALLOCA; 6700 enum MAX_ALLOCA MAX_ALLOCA;
6690 enum More_Lisp_Bits More_Lisp_Bits; 6701 enum More_Lisp_Bits More_Lisp_Bits;
6691 enum pvec_type pvec_type; 6702 enum pvec_type pvec_type;
6692#if USE_LSB_TAG
6693 enum lsb_bits lsb_bits;
6694#endif
6695} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; 6703} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
6696#endif /* __GNUC__ */ 6704#endif /* __GNUC__ */
diff --git a/src/buffer.c b/src/buffer.c
index abebdf21135..08299daa7dc 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -150,6 +150,12 @@ static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay
150static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); 150static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
151static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); 151static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
152 152
153static void
154CHECK_OVERLAY (Lisp_Object x)
155{
156 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
157}
158
153/* These setters are used only in this file, so they can be private. */ 159/* These setters are used only in this file, so they can be private. */
154static void 160static void
155bset_abbrev_mode (struct buffer *b, Lisp_Object val) 161bset_abbrev_mode (struct buffer *b, Lisp_Object val)
@@ -1539,7 +1545,7 @@ candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1539 && BUFFER_LIVE_P (XBUFFER (b)) 1545 && BUFFER_LIVE_P (XBUFFER (b))
1540 && !BUFFER_HIDDEN_P (XBUFFER (b))); 1546 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1541} 1547}
1542 1548
1543DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, 1549DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1544 doc: /* Return most recently selected buffer other than BUFFER. 1550 doc: /* Return most recently selected buffer other than BUFFER.
1545Buffers not visible in windows are preferred to visible buffers, unless 1551Buffers not visible in windows are preferred to visible buffers, unless
diff --git a/src/chartab.c b/src/chartab.c
index 7430235b4af..1c76e5a21e9 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -84,6 +84,22 @@ static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
84 (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ 84 (STRINGP (OBJ) && SCHARS (OBJ) > 0 \
85 && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) 85 && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2))))
86 86
87static void
88CHECK_CHAR_TABLE (Lisp_Object x)
89{
90 CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x);
91}
92
93static void
94set_char_table_ascii (Lisp_Object table, Lisp_Object val)
95{
96 XCHAR_TABLE (table)->ascii = val;
97}
98static void
99set_char_table_parent (Lisp_Object table, Lisp_Object val)
100{
101 XCHAR_TABLE (table)->parent = val;
102}
87 103
88DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, 104DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
89 doc: /* Return a newly created char-table, with purpose PURPOSE. 105 doc: /* Return a newly created char-table, with purpose PURPOSE.
diff --git a/src/coding.c b/src/coding.c
index 42fd81b6322..497c26d4856 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -655,6 +655,22 @@ static struct coding_system coding_categories[coding_category_max];
655 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ 655 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
656 } while (0) 656 } while (0)
657 657
658static void
659CHECK_NATNUM_CAR (Lisp_Object x)
660{
661 Lisp_Object tmp = XCAR (x);
662 CHECK_NATNUM (tmp);
663 XSETCAR (x, tmp);
664}
665
666static void
667CHECK_NATNUM_CDR (Lisp_Object x)
668{
669 Lisp_Object tmp = XCDR (x);
670 CHECK_NATNUM (tmp);
671 XSETCDR (x, tmp);
672}
673
658 674
659/* Safely get one byte from the source text pointed by SRC which ends 675/* Safely get one byte from the source text pointed by SRC which ends
660 at SRC_END, and set C to that byte. If there are not enough bytes 676 at SRC_END, and set C to that byte. If there are not enough bytes
diff --git a/src/data.c b/src/data.c
index 9f756de014a..955c39727bb 100644
--- a/src/data.c
+++ b/src/data.c
@@ -76,7 +76,8 @@ static Lisp_Object Qprocess, Qmarker;
76static Lisp_Object Qcompiled_function, Qframe; 76static Lisp_Object Qcompiled_function, Qframe;
77Lisp_Object Qbuffer; 77Lisp_Object Qbuffer;
78static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; 78static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
79static Lisp_Object Qsubrp, Qmany, Qunevalled; 79static Lisp_Object Qsubrp;
80static Lisp_Object Qmany, Qunevalled;
80Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; 81Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
81static Lisp_Object Qdefun; 82static Lisp_Object Qdefun;
82 83
@@ -85,6 +86,94 @@ static Lisp_Object Qdefalias_fset_function;
85 86
86static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); 87static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
87 88
89static bool
90BOOLFWDP (union Lisp_Fwd *a)
91{
92 return XFWDTYPE (a) == Lisp_Fwd_Bool;
93}
94static bool
95INTFWDP (union Lisp_Fwd *a)
96{
97 return XFWDTYPE (a) == Lisp_Fwd_Int;
98}
99static bool
100KBOARD_OBJFWDP (union Lisp_Fwd *a)
101{
102 return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
103}
104static bool
105OBJFWDP (union Lisp_Fwd *a)
106{
107 return XFWDTYPE (a) == Lisp_Fwd_Obj;
108}
109
110static struct Lisp_Boolfwd *
111XBOOLFWD (union Lisp_Fwd *a)
112{
113 eassert (BOOLFWDP (a));
114 return &a->u_boolfwd;
115}
116static struct Lisp_Kboard_Objfwd *
117XKBOARD_OBJFWD (union Lisp_Fwd *a)
118{
119 eassert (KBOARD_OBJFWDP (a));
120 return &a->u_kboard_objfwd;
121}
122static struct Lisp_Intfwd *
123XINTFWD (union Lisp_Fwd *a)
124{
125 eassert (INTFWDP (a));
126 return &a->u_intfwd;
127}
128static struct Lisp_Objfwd *
129XOBJFWD (union Lisp_Fwd *a)
130{
131 eassert (OBJFWDP (a));
132 return &a->u_objfwd;
133}
134
135static void
136CHECK_SUBR (Lisp_Object x)
137{
138 CHECK_TYPE (SUBRP (x), Qsubrp, x);
139}
140
141static void
142set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
143{
144 eassert (found == !EQ (blv->defcell, blv->valcell));
145 blv->found = found;
146}
147
148static Lisp_Object
149blv_value (struct Lisp_Buffer_Local_Value *blv)
150{
151 return XCDR (blv->valcell);
152}
153
154static void
155set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
156{
157 XSETCDR (blv->valcell, val);
158}
159
160static void
161set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
162{
163 blv->where = val;
164}
165
166static void
167set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
168{
169 blv->defcell = val;
170}
171
172static void
173set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
174{
175 blv->valcell = val;
176}
88 177
89Lisp_Object 178Lisp_Object
90wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) 179wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
diff --git a/src/dispextern.h b/src/dispextern.h
index 83e8792dfe0..401b3f2f6ae 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -22,6 +22,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22#ifndef DISPEXTERN_H_INCLUDED 22#ifndef DISPEXTERN_H_INCLUDED
23#define DISPEXTERN_H_INCLUDED 23#define DISPEXTERN_H_INCLUDED
24 24
25#include "character.h"
26
25#ifdef HAVE_X_WINDOWS 27#ifdef HAVE_X_WINDOWS
26 28
27#include <X11/Xlib.h> 29#include <X11/Xlib.h>
@@ -270,6 +272,55 @@ struct display_pos
270 Glyphs 272 Glyphs
271 ***********************************************************************/ 273 ***********************************************************************/
272 274
275/* The glyph datatype, used to represent characters on the display.
276 It consists of a char code and a face id. */
277
278typedef struct {
279 int ch;
280 int face_id;
281} GLYPH;
282
283/* Return a glyph's character code. */
284DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; }
285
286/* Return a glyph's face ID. */
287DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; }
288
289#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
290#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
291#define SET_GLYPH(glyph, char, face) \
292 ((glyph).ch = (char), (glyph).face_id = (face))
293
294/* The following are valid only if GLYPH_CODE_P (gc). */
295
296DISPEXTERN_INLINE int
297GLYPH_CODE_CHAR (Lisp_Object gc)
298{
299 return (CONSP (gc)
300 ? XINT (XCAR (gc))
301 : XINT (gc) & MAX_CHAR);
302}
303
304DISPEXTERN_INLINE int
305GLYPH_CODE_FACE (Lisp_Object gc)
306{
307 return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS;
308}
309
310#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
311 do \
312 { \
313 if (CONSP (gc)) \
314 SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
315 else \
316 SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
317 (XINT (gc) >> CHARACTERBITS)); \
318 } \
319 while (0)
320
321/* The ID of the mode line highlighting face. */
322enum { GLYPH_MODE_LINE_FACE = 1 };
323
273/* Enumeration of glyph types. Glyph structures contain a type field 324/* Enumeration of glyph types. Glyph structures contain a type field
274 containing one of the enumerators defined here. */ 325 containing one of the enumerators defined here. */
275 326
@@ -1774,6 +1825,30 @@ struct face_cache
1774 1825
1775#endif /* not HAVE_WINDOW_SYSTEM */ 1826#endif /* not HAVE_WINDOW_SYSTEM */
1776 1827
1828/* Return true if G contains a valid character code. */
1829DISPEXTERN_INLINE bool
1830GLYPH_CHAR_VALID_P (GLYPH g)
1831{
1832 return CHAR_VALID_P (GLYPH_CHAR (g));
1833}
1834
1835/* The glyph code from a display vector may either be an integer which
1836 encodes a char code in the lower CHARACTERBITS bits and a (very small)
1837 face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
1838
1839DISPEXTERN_INLINE bool
1840GLYPH_CODE_P (Lisp_Object gc)
1841{
1842 return (CONSP (gc)
1843 ? (CHARACTERP (XCAR (gc))
1844 && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID))
1845 : (RANGED_INTEGERP
1846 (0, gc,
1847 (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS
1848 ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR
1849 : TYPE_MAXIMUM (EMACS_INT)))));
1850}
1851
1777/* Non-zero means face attributes have been changed since the last 1852/* Non-zero means face attributes have been changed since the last
1778 redisplay. Used in redisplay_internal. */ 1853 redisplay. Used in redisplay_internal. */
1779 1854
diff --git a/src/emacs.c b/src/emacs.c
index 0035daa1da2..13f6d117ebc 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -306,6 +306,13 @@ bool fatal_error_in_progress;
306static void *ns_pool; 306static void *ns_pool;
307#endif 307#endif
308 308
309#if !HAVE_SETLOCALE
310static char *
311setlocale (int cat, char const *locale)
312{
313 return 0;
314}
315#endif
309 316
310 317
311/* Report a fatal error due to signal SIG, output a backtrace of at 318/* Report a fatal error due to signal SIG, output a backtrace of at
diff --git a/src/eval.c b/src/eval.c
index d1d074df777..1b2f3bdc048 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -115,6 +115,69 @@ Lisp_Object inhibit_lisp_code;
115static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); 115static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
116static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); 116static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
117 117
118static Lisp_Object
119specpdl_symbol (struct specbinding *pdl)
120{
121 eassert (pdl->kind >= SPECPDL_LET);
122 return pdl->v.let.symbol;
123}
124
125static Lisp_Object
126specpdl_old_value (struct specbinding *pdl)
127{
128 eassert (pdl->kind >= SPECPDL_LET);
129 return pdl->v.let.old_value;
130}
131
132static Lisp_Object
133specpdl_where (struct specbinding *pdl)
134{
135 eassert (pdl->kind > SPECPDL_LET);
136 return pdl->v.let.where;
137}
138
139static Lisp_Object
140specpdl_arg (struct specbinding *pdl)
141{
142 eassert (pdl->kind == SPECPDL_UNWIND);
143 return pdl->v.unwind.arg;
144}
145
146static specbinding_func
147specpdl_func (struct specbinding *pdl)
148{
149 eassert (pdl->kind == SPECPDL_UNWIND);
150 return pdl->v.unwind.func;
151}
152
153static Lisp_Object
154backtrace_function (struct specbinding *pdl)
155{
156 eassert (pdl->kind == SPECPDL_BACKTRACE);
157 return pdl->v.bt.function;
158}
159
160static ptrdiff_t
161backtrace_nargs (struct specbinding *pdl)
162{
163 eassert (pdl->kind == SPECPDL_BACKTRACE);
164 return pdl->v.bt.nargs;
165}
166
167static Lisp_Object *
168backtrace_args (struct specbinding *pdl)
169{
170 eassert (pdl->kind == SPECPDL_BACKTRACE);
171 return pdl->v.bt.args;
172}
173
174static bool
175backtrace_debug_on_exit (struct specbinding *pdl)
176{
177 eassert (pdl->kind == SPECPDL_BACKTRACE);
178 return pdl->v.bt.debug_on_exit;
179}
180
118/* Functions to modify slots of backtrace records. */ 181/* Functions to modify slots of backtrace records. */
119 182
120static void 183static void
diff --git a/src/floatfns.c b/src/floatfns.c
index 6113758f964..d7514eca886 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -41,6 +41,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
41# define isnan(x) ((x) != (x)) 41# define isnan(x) ((x) != (x))
42#endif 42#endif
43 43
44/* Check that X is a floating point number. */
45
46static void
47CHECK_FLOAT (Lisp_Object x)
48{
49 CHECK_TYPE (FLOATP (x), Qfloatp, x);
50}
51
44/* Extract a Lisp number as a `double', or signal an error. */ 52/* Extract a Lisp number as a `double', or signal an error. */
45 53
46double 54double
diff --git a/src/fns.c b/src/fns.c
index 7a230e61a3c..7a8ddc04540 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -91,6 +91,12 @@ enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
91 91
92/* Random data-structure functions. */ 92/* Random data-structure functions. */
93 93
94static void
95CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
96{
97 CHECK_TYPE (NILP (x), Qlistp, y);
98}
99
94DEFUN ("length", Flength, Slength, 1, 1, 0, 100DEFUN ("length", Flength, Slength, 1, 1, 0,
95 doc: /* Return the length of vector, list or string SEQUENCE. 101 doc: /* Return the length of vector, list or string SEQUENCE.
96A byte-code function object is also allowed. 102A byte-code function object is also allowed.
@@ -3337,7 +3343,8 @@ static struct Lisp_Hash_Table *weak_hash_tables;
3337 3343
3338/* Various symbols. */ 3344/* Various symbols. */
3339 3345
3340static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; 3346static Lisp_Object Qhash_table_p;
3347static Lisp_Object Qkey, Qvalue, Qeql;
3341Lisp_Object Qeq, Qequal; 3348Lisp_Object Qeq, Qequal;
3342Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; 3349Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
3343static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; 3350static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
@@ -3347,6 +3354,48 @@ static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
3347 Utilities 3354 Utilities
3348 ***********************************************************************/ 3355 ***********************************************************************/
3349 3356
3357static void
3358CHECK_HASH_TABLE (Lisp_Object x)
3359{
3360 CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x);
3361}
3362
3363static void
3364set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
3365{
3366 h->key_and_value = key_and_value;
3367}
3368static void
3369set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
3370{
3371 h->next = next;
3372}
3373static void
3374set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3375{
3376 gc_aset (h->next, idx, val);
3377}
3378static void
3379set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
3380{
3381 h->hash = hash;
3382}
3383static void
3384set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3385{
3386 gc_aset (h->hash, idx, val);
3387}
3388static void
3389set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
3390{
3391 h->index = index;
3392}
3393static void
3394set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3395{
3396 gc_aset (h->index, idx, val);
3397}
3398
3350/* If OBJ is a Lisp hash table, return a pointer to its struct 3399/* If OBJ is a Lisp hash table, return a pointer to its struct
3351 Lisp_Hash_Table. Otherwise, signal an error. */ 3400 Lisp_Hash_Table. Otherwise, signal an error. */
3352 3401
diff --git a/src/keymap.c b/src/keymap.c
index 536db77f59b..4e3eff332cc 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -106,6 +106,12 @@ static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
106 Lisp_Object, Lisp_Object, bool, bool); 106 Lisp_Object, Lisp_Object, bool, bool);
107static void silly_event_symbol_error (Lisp_Object); 107static void silly_event_symbol_error (Lisp_Object);
108static Lisp_Object get_keyelt (Lisp_Object, bool); 108static Lisp_Object get_keyelt (Lisp_Object, bool);
109
110static void
111CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
112{
113 CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x);
114}
109 115
110/* Keymap object support - constructors and predicates. */ 116/* Keymap object support - constructors and predicates. */
111 117
diff --git a/src/lisp.h b/src/lisp.h
index ba36a320a8f..f76bbfb9ead 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -220,6 +220,139 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
220#endif 220#endif
221 221
222 222
223/* Some operations are so commonly executed that they are implemented
224 as macros, not functions, because otherwise runtime performance would
225 suffer too much when compiling with GCC without optimization.
226 There's no need to inline everything, just the operations that
227 would otherwise cause a serious performance problem.
228
229 For each such operation OP, define a macro lisp_h_OP that contains
230 the operation's implementation. That way, OP can be implementated
231 via a macro definition like this:
232
233 #define OP(x) lisp_h_OP (x)
234
235 and/or via a function definition like this:
236
237 LISP_MACRO_DEFUN (OP, Lisp_Object, (Lisp_Object x), (x))
238
239 which macro-expands to this:
240
241 Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); }
242
243 without worrying about the implementations diverging, since
244 lisp_h_OP defines the actual implementation. The lisp_h_OP macros
245 are intended to be private to this include file, and should not be
246 used elsewhere.
247
248 FIXME: Remove the lisp_h_OP macros, and define just the inline OP
249 functions, once most developers have access to GCC 4.8 or later and
250 can use "gcc -Og" to debug. Maybe in the year 2016. See
251 Bug#11935.
252
253 Commentary for these macros can be found near their corresponding
254 functions, below. */
255
256#if CHECK_LISP_OBJECT_TYPE
257# define lisp_h_XLI(o) ((o).i)
258# define lisp_h_XIL(i) ((Lisp_Object) { i })
259#else
260# define lisp_h_XLI(o) (o)
261# define lisp_h_XIL(i) (i)
262#endif
263#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
264#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
265#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
266#define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \
267 ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x))
268#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons)
269#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
270#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float)
271#define lisp_h_INTEGERP(x) ((XTYPE (x) & ~Lisp_Int1) == 0)
272#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
273#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
274#define lisp_h_NILP(x) EQ (x, Qnil)
275#define lisp_h_SET_SYMBOL_VAL(sym, v) \
276 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
277#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
278#define lisp_h_SYMBOL_VAL(sym) \
279 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
280#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
281#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
282#define lisp_h_XCAR(c) XCONS (c)->car
283#define lisp_h_XCDR(c) XCONS (c)->u.cdr
284#define lisp_h_XCONS(a) \
285 (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
286#define lisp_h_XHASH(a) XUINT (a)
287#define lisp_h_XPNTR(a) \
288 ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS))
289#define lisp_h_XSYMBOL(a) \
290 (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
291#ifndef GC_CHECK_CONS_LIST
292# define lisp_h_check_cons_list() ((void) 0)
293#endif
294#if USE_LSB_TAG
295# define lisp_h_make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS)
296# define lisp_h_XFASTINT(a) XINT (a)
297# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
298# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
299# define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type)))
300#endif
301
302/* When compiling via gcc -O0, define the key operations as macros, as
303 Emacs is too slow otherwise. To disable this optimization, compile
304 with -DINLINING=0. */
305#if (defined __NO_INLINE__ \
306 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
307 && ! (defined INLINING && ! INLINING))
308# define XLI(o) lisp_h_XLI (o)
309# define XIL(i) lisp_h_XIL (i)
310# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
311# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
312# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
313# define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x)
314# define CONSP(x) lisp_h_CONSP (x)
315# define EQ(x, y) lisp_h_EQ (x, y)
316# define FLOATP(x) lisp_h_FLOATP (x)
317# define INTEGERP(x) lisp_h_INTEGERP (x)
318# define MARKERP(x) lisp_h_MARKERP (x)
319# define MISCP(x) lisp_h_MISCP (x)
320# define NILP(x) lisp_h_NILP (x)
321# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
322# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
323# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
324# define SYMBOLP(x) lisp_h_SYMBOLP (x)
325# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
326# define XCAR(c) lisp_h_XCAR (c)
327# define XCDR(c) lisp_h_XCDR (c)
328# define XCONS(a) lisp_h_XCONS (a)
329# define XHASH(a) lisp_h_XHASH (a)
330# define XPNTR(a) lisp_h_XPNTR (a)
331# define XSYMBOL(a) lisp_h_XSYMBOL (a)
332# ifndef GC_CHECK_CONS_LIST
333# define check_cons_list() lisp_h_check_cons_list ()
334# endif
335# if USE_LSB_TAG
336# define make_number(n) lisp_h_make_number (n)
337# define XFASTINT(a) lisp_h_XFASTINT (a)
338# define XINT(a) lisp_h_XINT (a)
339# define XTYPE(a) lisp_h_XTYPE (a)
340# define XUNTAG(a, type) lisp_h_XUNTAG (a, type)
341# endif
342#endif
343
344/* Define NAME as a lisp.h inline function that returns TYPE and has
345 arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and
346 ARGS should be parenthesized. Implement the function by calling
347 lisp_h_NAME ARGS. */
348#define LISP_MACRO_DEFUN(name, type, argdecls, args) \
349 LISP_INLINE type (name) argdecls { return lisp_h_##name args; }
350
351/* like LISP_MACRO_DEFUN, except NAME returns void. */
352#define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \
353 LISP_INLINE void (name) argdecls { lisp_h_##name args; }
354
355
223/* Define the fundamental Lisp data structures. */ 356/* Define the fundamental Lisp data structures. */
224 357
225/* This is the set of Lisp data types. If you want to define a new 358/* This is the set of Lisp data types. If you want to define a new
@@ -230,7 +363,6 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
230 extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ 363 extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
231#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) 364#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
232#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 365#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
233#define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0)
234 366
235/* Idea stolen from GDB. MSVC doesn't support enums in bitfields, 367/* Idea stolen from GDB. MSVC doesn't support enums in bitfields,
236 and xlc complains vociferously about them. */ 368 and xlc complains vociferously about them. */
@@ -359,20 +491,6 @@ enum Lisp_Fwd_Type
359 491
360typedef struct { EMACS_INT i; } Lisp_Object; 492typedef struct { EMACS_INT i; } Lisp_Object;
361 493
362#define XLI(o) (o).i
363LISP_INLINE Lisp_Object
364XIL (EMACS_INT i)
365{
366 Lisp_Object o = { i };
367 return o;
368}
369
370LISP_INLINE Lisp_Object
371LISP_MAKE_RVALUE (Lisp_Object o)
372{
373 return o;
374}
375
376#define LISP_INITIALLY_ZERO {0} 494#define LISP_INITIALLY_ZERO {0}
377 495
378#undef CHECK_LISP_OBJECT_TYPE 496#undef CHECK_LISP_OBJECT_TYPE
@@ -382,13 +500,15 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 };
382/* If a struct type is not wanted, define Lisp_Object as just a number. */ 500/* If a struct type is not wanted, define Lisp_Object as just a number. */
383 501
384typedef EMACS_INT Lisp_Object; 502typedef EMACS_INT Lisp_Object;
385#define XLI(o) (o)
386#define XIL(i) (i)
387#define LISP_MAKE_RVALUE(o) (0 + (o))
388#define LISP_INITIALLY_ZERO 0 503#define LISP_INITIALLY_ZERO 0
389enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; 504enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 };
390#endif /* CHECK_LISP_OBJECT_TYPE */ 505#endif /* CHECK_LISP_OBJECT_TYPE */
391 506
507/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
508 At the machine level, these operations are no-ops. */
509LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o))
510LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i))
511
392/* In the size word of a vector, this bit means the vector has been marked. */ 512/* In the size word of a vector, this bit means the vector has been marked. */
393 513
394static ptrdiff_t const ARRAY_MARK_FLAG 514static ptrdiff_t const ARRAY_MARK_FLAG
@@ -460,84 +580,108 @@ enum More_Lisp_Bits
460 BOOL_VECTOR_BITS_PER_CHAR = 8 580 BOOL_VECTOR_BITS_PER_CHAR = 8
461 }; 581 };
462 582
463/* These macros extract various sorts of values from a Lisp_Object. 583/* These functions extract various sorts of values from a Lisp_Object.
464 For example, if tem is a Lisp_Object whose type is Lisp_Cons, 584 For example, if tem is a Lisp_Object whose type is Lisp_Cons,
465 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ 585 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
466 586
467#if USE_LSB_TAG 587static EMACS_INT const VALMASK
588#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
589 = VALMASK;
468 590
469enum lsb_bits 591/* Largest and smallest representable fixnum values. These are the C
470 { 592 values. They are macros for use in static initializers. */
471 TYPEMASK = (1 << GCTYPEBITS) - 1, 593#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
472 VALMASK = ~ TYPEMASK 594#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
473 };
474#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK))
475#define XINT(a) (XLI (a) >> INTTYPEBITS)
476#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS)
477#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS)
478#define make_lisp_ptr(ptr, type) \
479 (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \
480 XIL ((type) | (intptr_t) (ptr)))
481 595
482#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) 596/* Extract the pointer hidden within A. */
483#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) 597LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a))
484 598
485#else /* not USE_LSB_TAG */ 599#if USE_LSB_TAG
486 600
487static EMACS_INT const VALMASK 601LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n))
488#define VALMASK VAL_MAX 602LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a))
489 = VALMASK; 603LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a))
604LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a))
605LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type))
490 606
491#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) 607#else /* ! USE_LSB_TAG */
492 608
493/* For integers known to be positive, XFASTINT provides fast retrieval 609/* Although compiled only if ! USE_LSB_TAG, the following functions
494 and XSETFASTINT provides fast storage. This takes advantage of the 610 also work when USE_LSB_TAG; this is to aid future maintenance when
495 fact that Lisp integers have zero-bits in their tags. */ 611 the lisp_h_* macros are eventually removed. */
496#define XFASTINT(a) (XLI (a) + 0)
497#define XSETFASTINT(a, b) ((a) = XIL (b))
498 612
499/* Extract the value of a Lisp_Object as a (un)signed integer. */ 613/* Make a Lisp integer representing the value of the low order
614 bits of N. */
615LISP_INLINE Lisp_Object
616make_number (EMACS_INT n)
617{
618 return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK);
619}
500 620
501#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) 621/* Extract A's value as a signed integer. */
502#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) 622LISP_INLINE EMACS_INT
503#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) 623XINT (Lisp_Object a)
624{
625 EMACS_INT i = XLI (a);
626 return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS;
627}
504 628
505#define make_lisp_ptr(ptr, type) \ 629/* Like XINT (A), but may be faster. A must be nonnegative.
506 (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ 630 If ! USE_LSB_TAG, this takes advantage of the fact that Lisp
507 + ((intptr_t) (ptr) & VALMASK))) 631 integers have zero-bits in their tags. */
632LISP_INLINE EMACS_INT
633XFASTINT (Lisp_Object a)
634{
635 EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a);
636 eassert (0 <= n);
637 return n;
638}
508 639
509/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers 640/* Extract A's type. */
510 which were stored in a Lisp_Object. */ 641LISP_INLINE enum Lisp_Type
511#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) 642XTYPE (Lisp_Object a)
643{
644 EMACS_UINT i = XLI (a);
645 return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
646}
512 647
513#endif /* not USE_LSB_TAG */ 648/* Extract A's pointer value, assuming A's type is TYPE. */
649LISP_INLINE void *
650XUNTAG (Lisp_Object a, int type)
651{
652 if (USE_LSB_TAG)
653 {
654 intptr_t i = XLI (a) - type;
655 return (void *) i;
656 }
657 return XPNTR (a);
658}
514 659
515/* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be 660#endif /* ! USE_LSB_TAG */
516 like XUINT right now, but XUINT should only be applied to objects we know
517 are integers. */
518#define XHASH(a) XUINT (a)
519 661
520/* For integers known to be positive, XFASTINT sometimes provides 662/* Extract A's value as an unsigned integer. */
521 faster retrieval and XSETFASTINT provides faster storage. 663LISP_INLINE EMACS_UINT
522 If not, fallback on the non-accelerated path. */ 664XUINT (Lisp_Object a)
523#ifndef XFASTINT 665{
524# define XFASTINT(a) (XINT (a)) 666 EMACS_UINT i = XLI (a);
525# define XSETFASTINT(a, b) (XSETINT (a, b)) 667 return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
526#endif 668}
527 669
528/* Extract the pointer value of the Lisp object A, under the 670/* Return A's (Lisp-integer sized) hash. Happens to be like XUINT
529 assumption that A's type is TYPE. This is a fallback 671 right now, but XUINT should only be applied to objects we know are
530 implementation if nothing faster is available. */ 672 integers. */
531#ifndef XUNTAG 673LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a))
532# define XUNTAG(a, type) XPNTR (a)
533#endif
534 674
535#define EQ(x, y) (XLI (x) == XLI (y)) 675/* Like make_number (N), but may be faster. N must be in nonnegative range. */
676LISP_INLINE Lisp_Object
677make_natnum (EMACS_INT n)
678{
679 eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
680 return USE_LSB_TAG ? make_number (n) : XIL (n);
681}
536 682
537/* Largest and smallest representable fixnum values. These are the C 683/* Return true if X and Y are the same object. */
538 values. They are macros for use in static initializers. */ 684LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y))
539#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
540#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
541 685
542/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is 686/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
543 written this way so that it also works if I is of unsigned 687 written this way so that it also works if I is of unsigned
@@ -551,66 +695,173 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
551{ 695{
552 return num < lower ? lower : num <= upper ? num : upper; 696 return num < lower ? lower : num <= upper ? num : upper;
553} 697}
698
699/* Forward declarations. */
700
701/* Defined in this file. */
702union Lisp_Fwd;
703LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object);
704LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
705LISP_INLINE bool BUFFERP (Lisp_Object);
706LISP_INLINE bool CHAR_TABLE_P (Lisp_Object);
707LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
708LISP_INLINE bool (CONSP) (Lisp_Object);
709LISP_INLINE bool (FLOATP) (Lisp_Object);
710LISP_INLINE bool functionp (Lisp_Object);
711LISP_INLINE bool (INTEGERP) (Lisp_Object);
712LISP_INLINE bool (MARKERP) (Lisp_Object);
713LISP_INLINE bool (MISCP) (Lisp_Object);
714LISP_INLINE bool (NILP) (Lisp_Object);
715LISP_INLINE bool OVERLAYP (Lisp_Object);
716LISP_INLINE bool PROCESSP (Lisp_Object);
717LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int);
718LISP_INLINE bool SAVE_VALUEP (Lisp_Object);
719LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
720 Lisp_Object);
721LISP_INLINE bool STRINGP (Lisp_Object);
722LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
723LISP_INLINE bool SUBRP (Lisp_Object);
724LISP_INLINE bool (SYMBOLP) (Lisp_Object);
725LISP_INLINE bool (VECTORLIKEP) (Lisp_Object);
726LISP_INLINE bool WINDOWP (Lisp_Object);
727LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
728
729/* Defined in chartab.c. */
730extern Lisp_Object char_table_ref (Lisp_Object, int);
731extern void char_table_set (Lisp_Object, int, Lisp_Object);
732extern int char_table_translate (Lisp_Object, int);
733
734/* Defined in data.c. */
735extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
736extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
737extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp;
738extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
739extern Lisp_Object Ffboundp (Lisp_Object);
740extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
741
742/* Defined in emacs.c. */
743extern bool initialized;
744
745/* Defined in eval.c. */
746extern Lisp_Object Qautoload;
747
748/* Defined in floatfns.c. */
749extern double extract_float (Lisp_Object);
554 750
751/* Defined in process.c. */
752extern Lisp_Object Qprocessp;
753
754/* Defined in window.c. */
755extern Lisp_Object Qwindowp;
756
757/* Defined in xdisp.c. */
758extern Lisp_Object Qimage;
555 759
760
556/* Extract a value or address from a Lisp_Object. */ 761/* Extract a value or address from a Lisp_Object. */
557 762
558#define XCONS(a) (eassert (CONSP (a)), \ 763LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a))
559 (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
560#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
561 (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
562#define XSTRING(a) (eassert (STRINGP (a)), \
563 (struct Lisp_String *) XUNTAG (a, Lisp_String))
564#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
565 (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
566#define XFLOAT(a) (eassert (FLOATP (a)), \
567 (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
568 764
569/* Misc types. */ 765LISP_INLINE struct Lisp_Vector *
766XVECTOR (Lisp_Object a)
767{
768 eassert (VECTORLIKEP (a));
769 return XUNTAG (a, Lisp_Vectorlike);
770}
570 771
571#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) 772LISP_INLINE struct Lisp_String *
572#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) 773XSTRING (Lisp_Object a)
573#define XMISCTYPE(a) (XMISCANY (a)->type) 774{
574#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) 775 eassert (STRINGP (a));
575#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) 776 return XUNTAG (a, Lisp_String);
777}
576 778
577/* Forwarding object types. */ 779LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
578 780
579#define XFWDTYPE(a) (a->u_intfwd.type) 781LISP_INLINE struct Lisp_Float *
580#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) 782XFLOAT (Lisp_Object a)
581#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) 783{
582#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) 784 eassert (FLOATP (a));
583#define XBUFFER_OBJFWD(a) \ 785 return XUNTAG (a, Lisp_Float);
584 (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) 786}
585#define XKBOARD_OBJFWD(a) \
586 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
587 787
588/* Pseudovector types. */ 788/* Pseudovector types. */
589struct Lisp_Process; 789
590LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) 790LISP_INLINE struct Lisp_Process *
591{ return make_lisp_ptr (p, Lisp_Vectorlike); } 791XPROCESS (Lisp_Object a)
592#define XPROCESS(a) (eassert (PROCESSP (a)), \ 792{
593 (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) 793 eassert (PROCESSP (a));
594#define XWINDOW(a) (eassert (WINDOWP (a)), \ 794 return XUNTAG (a, Lisp_Vectorlike);
595 (struct window *) XUNTAG (a, Lisp_Vectorlike)) 795}
596#define XTERMINAL(a) (eassert (TERMINALP (a)), \ 796
597 (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) 797LISP_INLINE struct window *
598#define XSUBR(a) (eassert (SUBRP (a)), \ 798XWINDOW (Lisp_Object a)
599 (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) 799{
600#define XBUFFER(a) (eassert (BUFFERP (a)), \ 800 eassert (WINDOWP (a));
601 (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) 801 return XUNTAG (a, Lisp_Vectorlike);
602#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ 802}
603 (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) 803
604#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ 804LISP_INLINE struct terminal *
605 ((struct Lisp_Sub_Char_Table *) \ 805XTERMINAL (Lisp_Object a)
606 XUNTAG (a, Lisp_Vectorlike))) 806{
607#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ 807 return XUNTAG (a, Lisp_Vectorlike);
608 ((struct Lisp_Bool_Vector *) \ 808}
609 XUNTAG (a, Lisp_Vectorlike))) 809
810LISP_INLINE struct Lisp_Subr *
811XSUBR (Lisp_Object a)
812{
813 eassert (SUBRP (a));
814 return XUNTAG (a, Lisp_Vectorlike);
815}
816
817LISP_INLINE struct buffer *
818XBUFFER (Lisp_Object a)
819{
820 eassert (BUFFERP (a));
821 return XUNTAG (a, Lisp_Vectorlike);
822}
823
824LISP_INLINE struct Lisp_Char_Table *
825XCHAR_TABLE (Lisp_Object a)
826{
827 eassert (CHAR_TABLE_P (a));
828 return XUNTAG (a, Lisp_Vectorlike);
829}
830
831LISP_INLINE struct Lisp_Sub_Char_Table *
832XSUB_CHAR_TABLE (Lisp_Object a)
833{
834 eassert (SUB_CHAR_TABLE_P (a));
835 return XUNTAG (a, Lisp_Vectorlike);
836}
837
838LISP_INLINE struct Lisp_Bool_Vector *
839XBOOL_VECTOR (Lisp_Object a)
840{
841 eassert (BOOL_VECTOR_P (a));
842 return XUNTAG (a, Lisp_Vectorlike);
843}
610 844
611/* Construct a Lisp_Object from a value or address. */ 845/* Construct a Lisp_Object from a value or address. */
612 846
847LISP_INLINE Lisp_Object
848make_lisp_ptr (void *ptr, enum Lisp_Type type)
849{
850 EMACS_UINT utype = type;
851 EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS;
852 Lisp_Object a = XIL (typebits | (uintptr_t) ptr);
853 eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
854 return a;
855}
856
857LISP_INLINE Lisp_Object
858make_lisp_proc (struct Lisp_Process *p)
859{
860 return make_lisp_ptr (p, Lisp_Vectorlike);
861}
862
613#define XSETINT(a, b) ((a) = make_number (b)) 863#define XSETINT(a, b) ((a) = make_number (b))
864#define XSETFASTINT(a, b) ((a) = make_natnum (b))
614#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) 865#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
615#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) 866#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
616#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) 867#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
@@ -656,35 +907,10 @@ LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p)
656#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) 907#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
657#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) 908#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
658 909
659/* Convenience macros for dealing with Lisp arrays. */
660
661#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
662#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
663#define ASET(ARRAY, IDX, VAL) \
664 (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \
665 XVECTOR (ARRAY)->contents[IDX] = (VAL))
666
667/* Convenience macros for dealing with Lisp strings. */
668
669#define SDATA(string) (XSTRING (string)->data + 0)
670#define SREF(string, index) (SDATA (string)[index] + 0)
671#define SSET(string, index, new) (SDATA (string)[index] = (new))
672#define SCHARS(string) (XSTRING (string)->size + 0)
673#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0)
674
675/* Avoid "differ in sign" warnings. */
676#define SSDATA(x) ((char *) SDATA (x))
677
678#define STRING_SET_CHARS(string, newsize) \
679 (XSTRING (string)->size = (newsize))
680
681#define STRING_COPYIN(string, index, new, count) \
682 memcpy (SDATA (string) + index, new, count)
683
684/* Type checking. */ 910/* Type checking. */
685 911
686#define CHECK_TYPE(ok, Qxxxp, x) \ 912LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x),
687 do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) 913 (ok, Qxxxp, x))
688 914
689/* Deprecated and will be removed soon. */ 915/* Deprecated and will be removed soon. */
690 916
@@ -694,10 +920,6 @@ LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p)
694 920
695typedef struct interval *INTERVAL; 921typedef struct interval *INTERVAL;
696 922
697/* Complain if object is not string or buffer type. */
698#define CHECK_STRING_OR_BUFFER(x) \
699 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
700
701struct Lisp_Cons 923struct Lisp_Cons
702 { 924 {
703 /* Car of this cons cell. */ 925 /* Car of this cons cell. */
@@ -714,64 +936,86 @@ struct Lisp_Cons
714 }; 936 };
715 937
716/* Take the car or cdr of something known to be a cons cell. */ 938/* Take the car or cdr of something known to be a cons cell. */
717/* The _AS_LVALUE macros shouldn't be used outside of the minimal set 939/* The _addr functions shouldn't be used outside of the minimal set
718 of code that has to know what a cons cell looks like. Other code not 940 of code that has to know what a cons cell looks like. Other code not
719 part of the basic lisp implementation should assume that the car and cdr 941 part of the basic lisp implementation should assume that the car and cdr
720 fields are not accessible as lvalues. (What if we want to switch to 942 fields are not accessible. (What if we want to switch to
721 a copying collector someday? Cached cons cell field addresses may be 943 a copying collector someday? Cached cons cell field addresses may be
722 invalidated at arbitrary points.) */ 944 invalidated at arbitrary points.) */
723#define XCAR_AS_LVALUE(c) (XCONS (c)->car) 945LISP_INLINE Lisp_Object *
724#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) 946xcar_addr (Lisp_Object c)
947{
948 return &XCONS (c)->car;
949}
950LISP_INLINE Lisp_Object *
951xcdr_addr (Lisp_Object c)
952{
953 return &XCONS (c)->u.cdr;
954}
725 955
726/* Use these from normal code. */ 956/* Use these from normal code. */
727#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) 957LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c))
728#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) 958LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
729 959
730/* Use these to set the fields of a cons cell. 960/* Use these to set the fields of a cons cell.
731 961
732 Note that both arguments may refer to the same object, so 'n' 962 Note that both arguments may refer to the same object, so 'n'
733 should not be read after 'c' is first modified. Also, neither 963 should not be read after 'c' is first modified. */
734 argument should be evaluated more than once; side effects are 964LISP_INLINE void
735 especially common in the second argument. */ 965XSETCAR (Lisp_Object c, Lisp_Object n)
736#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) 966{
737#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) 967 *xcar_addr (c) = n;
968}
969LISP_INLINE void
970XSETCDR (Lisp_Object c, Lisp_Object n)
971{
972 *xcdr_addr (c) = n;
973}
738 974
739/* Take the car or cdr of something whose type is not known. */ 975/* Take the car or cdr of something whose type is not known. */
740#define CAR(c) \ 976LISP_INLINE Lisp_Object
741 (CONSP ((c)) ? XCAR ((c)) \ 977CAR (Lisp_Object c)
742 : NILP ((c)) ? Qnil \ 978{
743 : wrong_type_argument (Qlistp, (c))) 979 return (CONSP (c) ? XCAR (c)
744 980 : NILP (c) ? Qnil
745#define CDR(c) \ 981 : wrong_type_argument (Qlistp, c));
746 (CONSP ((c)) ? XCDR ((c)) \ 982}
747 : NILP ((c)) ? Qnil \ 983LISP_INLINE Lisp_Object
748 : wrong_type_argument (Qlistp, (c))) 984CDR (Lisp_Object c)
985{
986 return (CONSP (c) ? XCDR (c)
987 : NILP (c) ? Qnil
988 : wrong_type_argument (Qlistp, c));
989}
749 990
750/* Take the car or cdr of something whose type is not known. */ 991/* Take the car or cdr of something whose type is not known. */
751#define CAR_SAFE(c) \ 992LISP_INLINE Lisp_Object
752 (CONSP ((c)) ? XCAR ((c)) : Qnil) 993CAR_SAFE (Lisp_Object c)
753 994{
754#define CDR_SAFE(c) \ 995 return CONSP (c) ? XCAR (c) : Qnil;
755 (CONSP ((c)) ? XCDR ((c)) : Qnil) 996}
756 997LISP_INLINE Lisp_Object
757/* True if STR is a multibyte string. */ 998CDR_SAFE (Lisp_Object c)
758#define STRING_MULTIBYTE(STR) \ 999{
759 (XSTRING (STR)->size_byte >= 0) 1000 return CONSP (c) ? XCDR (c) : Qnil;
760 1001}
761/* Return the length in bytes of STR. */
762
763#ifdef GC_CHECK_STRING_BYTES
764
765struct Lisp_String;
766extern ptrdiff_t string_bytes (struct Lisp_String *);
767#define STRING_BYTES(S) string_bytes ((S))
768 1002
769#else /* not GC_CHECK_STRING_BYTES */ 1003/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
770 1004
771#define STRING_BYTES(STR) \ 1005struct Lisp_String
772 ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) 1006 {
1007 ptrdiff_t size;
1008 ptrdiff_t size_byte;
1009 INTERVAL intervals; /* Text properties in this string. */
1010 unsigned char *data;
1011 };
773 1012
774#endif /* not GC_CHECK_STRING_BYTES */ 1013/* True if STR is a multibyte string. */
1014LISP_INLINE bool
1015STRING_MULTIBYTE (Lisp_Object str)
1016{
1017 return 0 <= XSTRING (str)->size_byte;
1018}
775 1019
776/* An upper bound on the number of bytes in a Lisp string, not 1020/* An upper bound on the number of bytes in a Lisp string, not
777 counting the terminating null. This a tight enough bound to 1021 counting the terminating null. This a tight enough bound to
@@ -802,20 +1046,65 @@ extern ptrdiff_t string_bytes (struct Lisp_String *);
802 (STR) = empty_multibyte_string; \ 1046 (STR) = empty_multibyte_string; \
803 else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) 1047 else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
804 1048
805/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ 1049/* Convenience functions for dealing with Lisp strings. */
806 1050
807struct Lisp_String 1051LISP_INLINE unsigned char *
808 { 1052SDATA (Lisp_Object string)
809 ptrdiff_t size; 1053{
810 ptrdiff_t size_byte; 1054 return XSTRING (string)->data;
811 INTERVAL intervals; /* Text properties in this string. */ 1055}
812 unsigned char *data; 1056LISP_INLINE char *
813 }; 1057SSDATA (Lisp_Object string)
1058{
1059 /* Avoid "differ in sign" warnings. */
1060 return (char *) SDATA (string);
1061}
1062LISP_INLINE unsigned char
1063SREF (Lisp_Object string, ptrdiff_t index)
1064{
1065 return SDATA (string)[index];
1066}
1067LISP_INLINE void
1068SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
1069{
1070 SDATA (string)[index] = new;
1071}
1072LISP_INLINE ptrdiff_t
1073SCHARS (Lisp_Object string)
1074{
1075 return XSTRING (string)->size;
1076}
1077LISP_INLINE ptrdiff_t
1078STRING_BYTES (struct Lisp_String *s)
1079{
1080#ifdef GC_CHECK_STRING_BYTES
1081 extern ptrdiff_t string_bytes (struct Lisp_String *);
1082 return string_bytes (s);
1083#else
1084 return s->size_byte < 0 ? s->size : s->size_byte;
1085#endif
1086}
1087LISP_INLINE ptrdiff_t
1088SBYTES (Lisp_Object string)
1089{
1090 return STRING_BYTES (XSTRING (string));
1091}
1092LISP_INLINE void
1093STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
1094{
1095 XSTRING (string)->size = newsize;
1096}
1097LISP_INLINE void
1098STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new,
1099 ptrdiff_t count)
1100{
1101 memcpy (SDATA (string) + index, new, count);
1102}
814 1103
815/* Header of vector-like objects. This documents the layout constraints on 1104/* Header of vector-like objects. This documents the layout constraints on
816 vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents 1105 vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
817 compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR 1106 compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
818 and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, 1107 and PSEUDOVECTORP cast their pointers to struct vectorlike_header *,
819 because when two such pointers potentially alias, a compiler won't 1108 because when two such pointers potentially alias, a compiler won't
820 incorrectly reorder loads and stores to their size fields. See 1109 incorrectly reorder loads and stores to their size fields. See
821 <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ 1110 <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
@@ -874,6 +1163,42 @@ enum
874 word_size = sizeof (Lisp_Object) 1163 word_size = sizeof (Lisp_Object)
875 }; 1164 };
876 1165
1166/* Conveniences for dealing with Lisp arrays. */
1167
1168LISP_INLINE Lisp_Object
1169AREF (Lisp_Object array, ptrdiff_t idx)
1170{
1171 return XVECTOR (array)->contents[idx];
1172}
1173
1174LISP_INLINE Lisp_Object *
1175aref_addr (Lisp_Object array, ptrdiff_t idx)
1176{
1177 return & XVECTOR (array)->contents[idx];
1178}
1179
1180LISP_INLINE ptrdiff_t
1181ASIZE (Lisp_Object array)
1182{
1183 return XVECTOR (array)->header.size;
1184}
1185
1186LISP_INLINE void
1187ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1188{
1189 eassert (0 <= idx && idx < ASIZE (array));
1190 XVECTOR (array)->contents[idx] = val;
1191}
1192
1193LISP_INLINE void
1194gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1195{
1196 /* Like ASET, but also can be used in the garbage collector:
1197 sweep_weak_table calls set_hash_key etc. while the table is marked. */
1198 eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
1199 XVECTOR (array)->contents[idx] = val;
1200}
1201
877/* If a struct is made to look like a vector, this macro returns the length 1202/* If a struct is made to look like a vector, this macro returns the length
878 of the shortest vector that would hold that struct. */ 1203 of the shortest vector that would hold that struct. */
879 1204
@@ -887,43 +1212,6 @@ enum
887#define PSEUDOVECSIZE(type, nonlispfield) \ 1212#define PSEUDOVECSIZE(type, nonlispfield) \
888 ((offsetof (type, nonlispfield) - header_size) / word_size) 1213 ((offsetof (type, nonlispfield) - header_size) / word_size)
889 1214
890/* A char-table is a kind of vectorlike, with contents are like a
891 vector but with a few other slots. For some purposes, it makes
892 sense to handle a char-table with type struct Lisp_Vector. An
893 element of a char table can be any Lisp objects, but if it is a sub
894 char-table, we treat it a table that contains information of a
895 specific range of characters. A sub char-table has the same
896 structure as a vector. A sub char table appears only in an element
897 of a char-table, and there's no way to access it directly from
898 Emacs Lisp program. */
899
900#ifdef __GNUC__
901
902#define CHAR_TABLE_REF_ASCII(CT, IDX) \
903 ({struct Lisp_Char_Table *_tbl = NULL; \
904 Lisp_Object _val; \
905 do { \
906 _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \
907 _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \
908 : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \
909 if (NILP (_val)) \
910 _val = _tbl->defalt; \
911 } while (NILP (_val) && ! NILP (_tbl->parent)); \
912 _val; })
913
914#else /* not __GNUC__ */
915
916#define CHAR_TABLE_REF_ASCII(CT, IDX) \
917 (! NILP (XCHAR_TABLE (CT)->ascii) \
918 ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
919 ? XCHAR_TABLE (CT)->ascii \
920 : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \
921 ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \
922 : char_table_ref ((CT), (IDX))) \
923 : char_table_ref ((CT), (IDX)))
924
925#endif /* not __GNUC__ */
926
927/* Compute A OP B, using the unsigned comparison operator OP. A and B 1215/* Compute A OP B, using the unsigned comparison operator OP. A and B
928 should be integer expressions. This is not the same as 1216 should be integer expressions. This is not the same as
929 mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) 1217 mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
@@ -937,18 +1225,15 @@ enum
937/* Nonzero iff C is an ASCII character. */ 1225/* Nonzero iff C is an ASCII character. */
938#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) 1226#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
939 1227
940/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII 1228/* A char-table is a kind of vectorlike, with contents are like a
941 characters. Do not check validity of CT. */ 1229 vector but with a few other slots. For some purposes, it makes
942#define CHAR_TABLE_REF(CT, IDX) \ 1230 sense to handle a char-table with type struct Lisp_Vector. An
943 (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ 1231 element of a char table can be any Lisp objects, but if it is a sub
944 : char_table_ref ((CT), (IDX))) 1232 char-table, we treat it a table that contains information of a
945 1233 specific range of characters. A sub char-table has the same
946/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and 1234 structure as a vector. A sub char table appears only in an element
947 8-bit European characters. Do not check validity of CT. */ 1235 of a char-table, and there's no way to access it directly from
948#define CHAR_TABLE_SET(CT, IDX, VAL) \ 1236 Emacs Lisp program. */
949 (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
950 ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
951 : char_table_set (CT, IDX, VAL))
952 1237
953enum CHARTAB_SIZE_BITS 1238enum CHARTAB_SIZE_BITS
954 { 1239 {
@@ -1012,6 +1297,45 @@ struct Lisp_Sub_Char_Table
1012 Lisp_Object contents[1]; 1297 Lisp_Object contents[1];
1013 }; 1298 };
1014 1299
1300LISP_INLINE Lisp_Object
1301CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
1302{
1303 struct Lisp_Char_Table *tbl = NULL;
1304 Lisp_Object val;
1305 do
1306 {
1307 tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct);
1308 val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii
1309 : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]);
1310 if (NILP (val))
1311 val = tbl->defalt;
1312 }
1313 while (NILP (val) && ! NILP (tbl->parent));
1314
1315 return val;
1316}
1317
1318/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
1319 characters. Do not check validity of CT. */
1320LISP_INLINE Lisp_Object
1321CHAR_TABLE_REF (Lisp_Object ct, int idx)
1322{
1323 return (ASCII_CHAR_P (idx)
1324 ? CHAR_TABLE_REF_ASCII (ct, idx)
1325 : char_table_ref (ct, idx));
1326}
1327
1328/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
1329 8-bit European characters. Do not check validity of CT. */
1330LISP_INLINE void
1331CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
1332{
1333 if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii))
1334 set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val);
1335 else
1336 char_table_set (ct, idx, val);
1337}
1338
1015/* This structure describes a built-in function. 1339/* This structure describes a built-in function.
1016 It is generated by the DEFUN macro only. 1340 It is generated by the DEFUN macro only.
1017 defsubr makes it into a Lisp object. */ 1341 defsubr makes it into a Lisp object. */
@@ -1048,8 +1372,12 @@ enum CHAR_TABLE_STANDARD_SLOTS
1048 1372
1049/* Return the number of "extra" slots in the char table CT. */ 1373/* Return the number of "extra" slots in the char table CT. */
1050 1374
1051#define CHAR_TABLE_EXTRA_SLOTS(CT) \ 1375LISP_INLINE int
1052 (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) 1376CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
1377{
1378 return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK)
1379 - CHAR_TABLE_STANDARD_SLOTS);
1380}
1053 1381
1054 1382
1055/*********************************************************************** 1383/***********************************************************************
@@ -1121,40 +1449,76 @@ struct Lisp_Symbol
1121 1449
1122/* Value is name of symbol. */ 1450/* Value is name of symbol. */
1123 1451
1124#define SYMBOL_VAL(sym) \ 1452LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
1125 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) 1453
1126#define SYMBOL_ALIAS(sym) \ 1454LISP_INLINE struct Lisp_Symbol *
1127 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) 1455SYMBOL_ALIAS (struct Lisp_Symbol *sym)
1128#define SYMBOL_BLV(sym) \ 1456{
1129 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) 1457 eassert (sym->redirect == SYMBOL_VARALIAS);
1130#define SYMBOL_FWD(sym) \ 1458 return sym->val.alias;
1131 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) 1459}
1132#define SET_SYMBOL_VAL(sym, v) \ 1460LISP_INLINE struct Lisp_Buffer_Local_Value *
1133 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) 1461SYMBOL_BLV (struct Lisp_Symbol *sym)
1134#define SET_SYMBOL_ALIAS(sym, v) \ 1462{
1135 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) 1463 eassert (sym->redirect == SYMBOL_LOCALIZED);
1136#define SET_SYMBOL_BLV(sym, v) \ 1464 return sym->val.blv;
1137 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) 1465}
1138#define SET_SYMBOL_FWD(sym, v) \ 1466LISP_INLINE union Lisp_Fwd *
1139 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) 1467SYMBOL_FWD (struct Lisp_Symbol *sym)
1468{
1469 eassert (sym->redirect == SYMBOL_FORWARDED);
1470 return sym->val.fwd;
1471}
1472
1473LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL,
1474 (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v))
1475
1476LISP_INLINE void
1477SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
1478{
1479 eassert (sym->redirect == SYMBOL_VARALIAS);
1480 sym->val.alias = v;
1481}
1482LISP_INLINE void
1483SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
1484{
1485 eassert (sym->redirect == SYMBOL_LOCALIZED);
1486 sym->val.blv = v;
1487}
1488LISP_INLINE void
1489SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
1490{
1491 eassert (sym->redirect == SYMBOL_FORWARDED);
1492 sym->val.fwd = v;
1493}
1140 1494
1141#define SYMBOL_NAME(sym) XSYMBOL (sym)->name 1495LISP_INLINE Lisp_Object
1496SYMBOL_NAME (Lisp_Object sym)
1497{
1498 return XSYMBOL (sym)->name;
1499}
1142 1500
1143/* Value is non-zero if SYM is an interned symbol. */ 1501/* Value is true if SYM is an interned symbol. */
1144 1502
1145#define SYMBOL_INTERNED_P(sym) \ 1503LISP_INLINE bool
1146 (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) 1504SYMBOL_INTERNED_P (Lisp_Object sym)
1505{
1506 return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
1507}
1147 1508
1148/* Value is non-zero if SYM is interned in initial_obarray. */ 1509/* Value is true if SYM is interned in initial_obarray. */
1149 1510
1150#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ 1511LISP_INLINE bool
1151 (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) 1512SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
1513{
1514 return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
1515}
1152 1516
1153/* Value is non-zero if symbol is considered a constant, i.e. its 1517/* Value is non-zero if symbol is considered a constant, i.e. its
1154 value cannot be changed (there is an exception for keyword symbols, 1518 value cannot be changed (there is an exception for keyword symbols,
1155 whose value can be set to the keyword symbol itself). */ 1519 whose value can be set to the keyword symbol itself). */
1156 1520
1157#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant 1521LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym))
1158 1522
1159#define DEFSYM(sym, name) \ 1523#define DEFSYM(sym, name) \
1160 do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) 1524 do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
@@ -1240,42 +1604,64 @@ struct Lisp_Hash_Table
1240}; 1604};
1241 1605
1242 1606
1243#define XHASH_TABLE(OBJ) \ 1607LISP_INLINE struct Lisp_Hash_Table *
1244 ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) 1608XHASH_TABLE (Lisp_Object a)
1609{
1610 return XUNTAG (a, Lisp_Vectorlike);
1611}
1245 1612
1246#define XSET_HASH_TABLE(VAR, PTR) \ 1613#define XSET_HASH_TABLE(VAR, PTR) \
1247 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) 1614 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
1248 1615
1249#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) 1616LISP_INLINE bool
1250 1617HASH_TABLE_P (Lisp_Object a)
1251#define CHECK_HASH_TABLE(x) \ 1618{
1252 CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) 1619 return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
1620}
1253 1621
1254/* Value is the key part of entry IDX in hash table H. */ 1622/* Value is the key part of entry IDX in hash table H. */
1255 1623LISP_INLINE Lisp_Object
1256#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) 1624HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1625{
1626 return AREF (h->key_and_value, 2 * idx);
1627}
1257 1628
1258/* Value is the value part of entry IDX in hash table H. */ 1629/* Value is the value part of entry IDX in hash table H. */
1259 1630LISP_INLINE Lisp_Object
1260#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) 1631HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1632{
1633 return AREF (h->key_and_value, 2 * idx + 1);
1634}
1261 1635
1262/* Value is the index of the next entry following the one at IDX 1636/* Value is the index of the next entry following the one at IDX
1263 in hash table H. */ 1637 in hash table H. */
1264 1638LISP_INLINE Lisp_Object
1265#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) 1639HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1640{
1641 return AREF (h->next, idx);
1642}
1266 1643
1267/* Value is the hash code computed for entry IDX in hash table H. */ 1644/* Value is the hash code computed for entry IDX in hash table H. */
1268 1645LISP_INLINE Lisp_Object
1269#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) 1646HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1647{
1648 return AREF (h->hash, idx);
1649}
1270 1650
1271/* Value is the index of the element in hash table H that is the 1651/* Value is the index of the element in hash table H that is the
1272 start of the collision list at index IDX in the index vector of H. */ 1652 start of the collision list at index IDX in the index vector of H. */
1273 1653LISP_INLINE Lisp_Object
1274#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) 1654HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1655{
1656 return AREF (h->index, idx);
1657}
1275 1658
1276/* Value is the size of hash table H. */ 1659/* Value is the size of hash table H. */
1277 1660LISP_INLINE ptrdiff_t
1278#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) 1661HASH_TABLE_SIZE (struct Lisp_Hash_Table *h)
1662{
1663 return ASIZE (h->next);
1664}
1279 1665
1280/* Default size for hash tables if not specified. */ 1666/* Default size for hash tables if not specified. */
1281 1667
@@ -1485,6 +1871,53 @@ struct Lisp_Save_Value
1485 } data[SAVE_VALUE_SLOTS]; 1871 } data[SAVE_VALUE_SLOTS];
1486 }; 1872 };
1487 1873
1874/* Return the type of V's Nth saved value. */
1875LISP_INLINE int
1876save_type (struct Lisp_Save_Value *v, int n)
1877{
1878 eassert (0 <= n && n < SAVE_VALUE_SLOTS);
1879 return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
1880}
1881
1882/* Get and set the Nth saved pointer. */
1883
1884LISP_INLINE void *
1885XSAVE_POINTER (Lisp_Object obj, int n)
1886{
1887 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
1888 return XSAVE_VALUE (obj)->data[n].pointer;;
1889}
1890LISP_INLINE void
1891set_save_pointer (Lisp_Object obj, int n, void *val)
1892{
1893 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
1894 XSAVE_VALUE (obj)->data[n].pointer = val;
1895}
1896
1897/* Likewise for the saved integer. */
1898
1899LISP_INLINE ptrdiff_t
1900XSAVE_INTEGER (Lisp_Object obj, int n)
1901{
1902 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
1903 return XSAVE_VALUE (obj)->data[n].integer;
1904}
1905LISP_INLINE void
1906set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
1907{
1908 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
1909 XSAVE_VALUE (obj)->data[n].integer = val;
1910}
1911
1912/* Extract Nth saved object. */
1913
1914LISP_INLINE Lisp_Object
1915XSAVE_OBJECT (Lisp_Object obj, int n)
1916{
1917 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
1918 return XSAVE_VALUE (obj)->data[n].object;
1919}
1920
1488/* A miscellaneous object, when it's on the free list. */ 1921/* A miscellaneous object, when it's on the free list. */
1489struct Lisp_Free 1922struct Lisp_Free
1490 { 1923 {
@@ -1506,6 +1939,46 @@ union Lisp_Misc
1506 struct Lisp_Save_Value u_save_value; 1939 struct Lisp_Save_Value u_save_value;
1507 }; 1940 };
1508 1941
1942LISP_INLINE union Lisp_Misc *
1943XMISC (Lisp_Object a)
1944{
1945 return XUNTAG (a, Lisp_Misc);
1946}
1947
1948LISP_INLINE struct Lisp_Misc_Any *
1949XMISCANY (Lisp_Object a)
1950{
1951 eassert (MISCP (a));
1952 return & XMISC (a)->u_any;
1953}
1954
1955LISP_INLINE enum Lisp_Misc_Type
1956XMISCTYPE (Lisp_Object a)
1957{
1958 return XMISCANY (a)->type;
1959}
1960
1961LISP_INLINE struct Lisp_Marker *
1962XMARKER (Lisp_Object a)
1963{
1964 eassert (MARKERP (a));
1965 return & XMISC (a)->u_marker;
1966}
1967
1968LISP_INLINE struct Lisp_Overlay *
1969XOVERLAY (Lisp_Object a)
1970{
1971 eassert (OVERLAYP (a));
1972 return & XMISC (a)->u_overlay;
1973}
1974
1975LISP_INLINE struct Lisp_Save_Value *
1976XSAVE_VALUE (Lisp_Object a)
1977{
1978 eassert (SAVE_VALUEP (a));
1979 return & XMISC (a)->u_save_value;
1980}
1981
1509/* Forwarding pointer to an int variable. 1982/* Forwarding pointer to an int variable.
1510 This is allowed only in the value cell of a symbol, 1983 This is allowed only in the value cell of a symbol,
1511 and it means that the symbol's value really lives in the 1984 and it means that the symbol's value really lives in the
@@ -1612,6 +2085,19 @@ union Lisp_Fwd
1612 struct Lisp_Buffer_Objfwd u_buffer_objfwd; 2085 struct Lisp_Buffer_Objfwd u_buffer_objfwd;
1613 struct Lisp_Kboard_Objfwd u_kboard_objfwd; 2086 struct Lisp_Kboard_Objfwd u_kboard_objfwd;
1614 }; 2087 };
2088
2089LISP_INLINE enum Lisp_Fwd_Type
2090XFWDTYPE (union Lisp_Fwd *a)
2091{
2092 return a->u_intfwd.type;
2093}
2094
2095LISP_INLINE struct Lisp_Buffer_Objfwd *
2096XBUFFER_OBJFWD (union Lisp_Fwd *a)
2097{
2098 eassert (BUFFER_OBJFWDP (a));
2099 return &a->u_buffer_objfwd;
2100}
1615 2101
1616/* Lisp floating point type. */ 2102/* Lisp floating point type. */
1617struct Lisp_Float 2103struct Lisp_Float
@@ -1623,8 +2109,11 @@ struct Lisp_Float
1623 } u; 2109 } u;
1624 }; 2110 };
1625 2111
1626#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) 2112LISP_INLINE double
1627#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) 2113XFLOAT_DATA (Lisp_Object f)
2114{
2115 return XFLOAT (f)->u.data;
2116}
1628 2117
1629/* Most hosts nowadays use IEEE floating point, so they use IEC 60559 2118/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
1630 representations, have infinities and NaNs, and do not trap on 2119 representations, have infinities and NaNs, and do not trap on
@@ -1633,8 +2122,12 @@ struct Lisp_Float
1633 wanted here, but is not quite right because Emacs does not require 2122 wanted here, but is not quite right because Emacs does not require
1634 all the features of C11 Annex F (and does not require C11 at all, 2123 all the features of C11 Annex F (and does not require C11 at all,
1635 for that matter). */ 2124 for that matter). */
1636#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ 2125enum
1637 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) 2126 {
2127 IEEE_FLOATING_POINT
2128 = (FLT_RADIX == 2 && FLT_MANT_DIG == 24
2129 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
2130 };
1638 2131
1639/* A character, declared with the following typedef, is a member 2132/* A character, declared with the following typedef, is a member
1640 of some character set associated with the current buffer. */ 2133 of some character set associated with the current buffer. */
@@ -1675,64 +2168,6 @@ enum char_bits
1675 itself. */ 2168 itself. */
1676 CHARACTERBITS = 22 2169 CHARACTERBITS = 22
1677 }; 2170 };
1678
1679
1680
1681
1682/* The glyph datatype, used to represent characters on the display.
1683 It consists of a char code and a face id. */
1684
1685typedef struct {
1686 int ch;
1687 int face_id;
1688} GLYPH;
1689
1690/* Return a glyph's character code. */
1691#define GLYPH_CHAR(glyph) ((glyph).ch)
1692
1693/* Return a glyph's face ID. */
1694#define GLYPH_FACE(glyph) ((glyph).face_id)
1695
1696#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
1697#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
1698#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face))
1699
1700/* Return 1 if GLYPH contains valid character code. */
1701#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph))
1702
1703
1704/* Glyph Code from a display vector may either be an integer which
1705 encodes a char code in the lower CHARACTERBITS bits and a (very small)
1706 face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
1707
1708#define GLYPH_CODE_P(gc) \
1709 (CONSP (gc) \
1710 ? (CHARACTERP (XCAR (gc)) \
1711 && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \
1712 : (RANGED_INTEGERP \
1713 (0, gc, \
1714 (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \
1715 ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \
1716 : TYPE_MAXIMUM (EMACS_INT)))))
1717
1718/* The following are valid only if GLYPH_CODE_P (gc). */
1719
1720#define GLYPH_CODE_CHAR(gc) \
1721 (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1))
1722
1723#define GLYPH_CODE_FACE(gc) \
1724 (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS)
1725
1726#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
1727 do \
1728 { \
1729 if (CONSP (gc)) \
1730 SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
1731 else \
1732 SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
1733 (XINT (gc) >> CHARACTERBITS)); \
1734 } \
1735 while (0)
1736 2171
1737/* Structure to hold mouse highlight data. This is here because other 2172/* Structure to hold mouse highlight data. This is here because other
1738 header files need it for defining struct x_output etc. */ 2173 header files need it for defining struct x_output etc. */
@@ -1768,190 +2203,235 @@ typedef struct {
1768 2203
1769/* Data type checking. */ 2204/* Data type checking. */
1770 2205
1771#define NILP(x) EQ (x, Qnil) 2206LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x))
1772
1773#define NUMBERP(x) (INTEGERP (x) || FLOATP (x))
1774#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0)
1775
1776#define RANGED_INTEGERP(lo, x, hi) \
1777 (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi))
1778#define TYPE_RANGED_INTEGERP(type, x) \
1779 (TYPE_SIGNED (type) \
1780 ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \
1781 : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type)))
1782
1783#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
1784#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
1785#define MISCP(x) (XTYPE ((x)) == Lisp_Misc)
1786#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike)
1787#define STRINGP(x) (XTYPE ((x)) == Lisp_String)
1788#define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
1789
1790#define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
1791#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG))
1792#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
1793#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
1794 2207
1795LISP_INLINE bool 2208LISP_INLINE bool
1796SAVE_VALUEP (Lisp_Object x) 2209NUMBERP (Lisp_Object x)
1797{ 2210{
1798 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; 2211 return INTEGERP (x) || FLOATP (x);
1799} 2212}
1800 2213LISP_INLINE bool
1801LISP_INLINE struct Lisp_Save_Value * 2214NATNUMP (Lisp_Object x)
1802XSAVE_VALUE (Lisp_Object a)
1803{ 2215{
1804 eassert (SAVE_VALUEP (a)); 2216 return INTEGERP (x) && 0 <= XINT (x);
1805 return & XMISC (a)->u_save_value;
1806} 2217}
1807 2218
1808/* Return the type of V's Nth saved value. */ 2219LISP_INLINE bool
1809LISP_INLINE int 2220RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi)
1810save_type (struct Lisp_Save_Value *v, int n)
1811{ 2221{
1812 eassert (0 <= n && n < SAVE_VALUE_SLOTS); 2222 return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi;
1813 return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
1814} 2223}
1815 2224
1816/* Get and set the Nth saved pointer. */ 2225#define TYPE_RANGED_INTEGERP(type, x) \
2226 (INTEGERP (x) \
2227 && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \
2228 && XINT (x) <= TYPE_MAXIMUM (type))
2229
2230LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x))
2231LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x))
2232LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x))
2233LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x))
2234LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x))
2235LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x))
2236LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x))
1817 2237
1818LISP_INLINE void * 2238LISP_INLINE bool
1819XSAVE_POINTER (Lisp_Object obj, int n) 2239STRINGP (Lisp_Object x)
1820{ 2240{
1821 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); 2241 return XTYPE (x) == Lisp_String;
1822 return XSAVE_VALUE (obj)->data[n].pointer;;
1823} 2242}
1824LISP_INLINE void 2243LISP_INLINE bool
1825set_save_pointer (Lisp_Object obj, int n, void *val) 2244VECTORP (Lisp_Object x)
1826{ 2245{
1827 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); 2246 return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG);
1828 XSAVE_VALUE (obj)->data[n].pointer = val;
1829} 2247}
1830 2248LISP_INLINE bool
1831/* Likewise for the saved integer. */ 2249OVERLAYP (Lisp_Object x)
1832
1833LISP_INLINE ptrdiff_t
1834XSAVE_INTEGER (Lisp_Object obj, int n)
1835{ 2250{
1836 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); 2251 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay;
1837 return XSAVE_VALUE (obj)->data[n].integer;
1838} 2252}
1839LISP_INLINE void 2253LISP_INLINE bool
1840set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) 2254SAVE_VALUEP (Lisp_Object x)
1841{ 2255{
1842 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); 2256 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
1843 XSAVE_VALUE (obj)->data[n].integer = val;
1844} 2257}
1845 2258
1846/* Extract Nth saved object. */ 2259LISP_INLINE bool
1847 2260AUTOLOADP (Lisp_Object x)
1848LISP_INLINE Lisp_Object
1849XSAVE_OBJECT (Lisp_Object obj, int n)
1850{ 2261{
1851 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); 2262 return CONSP (x) && EQ (Qautoload, XCAR (x));
1852 return XSAVE_VALUE (obj)->data[n].object;
1853} 2263}
1854 2264
1855#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) 2265LISP_INLINE bool
1856 2266BUFFER_OBJFWDP (union Lisp_Fwd *a)
1857#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) 2267{
1858#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) 2268 return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
1859#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) 2269}
1860#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
1861#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
1862 2270
1863/* True if object X is a pseudovector whose code is CODE. The cast to struct 2271LISP_INLINE bool
1864 vectorlike_header * avoids aliasing issues. */ 2272PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code)
1865#define PSEUDOVECTORP(x, code) \ 2273{
1866 TYPED_PSEUDOVECTORP (x, vectorlike_header, code) 2274 return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
2275 == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
2276}
1867 2277
1868#define PSEUDOVECTOR_TYPEP(v, code) \ 2278/* True if A is a pseudovector whose code is CODE. */
1869 (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ 2279LISP_INLINE bool
1870 == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) 2280PSEUDOVECTORP (Lisp_Object a, int code)
2281{
2282 if (! VECTORLIKEP (a))
2283 return 0;
2284 else
2285 {
2286 /* Converting to struct vectorlike_header * avoids aliasing issues. */
2287 struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike);
2288 return PSEUDOVECTOR_TYPEP (h, code);
2289 }
2290}
1871 2291
1872/* True if object X, with internal type struct T *, is a pseudovector whose
1873 code is CODE. */
1874#define TYPED_PSEUDOVECTORP(x, t, code) \
1875 (VECTORLIKEP (x) \
1876 && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code))
1877 2292
1878/* Test for specific pseudovector types. */ 2293/* Test for specific pseudovector types. */
1879#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
1880#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
1881#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
1882#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
1883#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
1884#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
1885#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
1886#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
1887#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
1888#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
1889#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
1890 2294
1891/* Test for image (image . spec) */ 2295LISP_INLINE bool
1892#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) 2296WINDOW_CONFIGURATIONP (Lisp_Object a)
1893 2297{
1894/* Array types. */ 2298 return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION);
1895 2299}
1896#define ARRAYP(x) \
1897 (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
1898
1899#define CHECK_LIST(x) \
1900 CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
1901
1902#define CHECK_LIST_CONS(x, y) \
1903 CHECK_TYPE (CONSP (x), Qlistp, y)
1904
1905#define CHECK_LIST_END(x, y) \
1906 CHECK_TYPE (NILP (x), Qlistp, y)
1907
1908#define CHECK_STRING(x) \
1909 CHECK_TYPE (STRINGP (x), Qstringp, x)
1910
1911#define CHECK_STRING_CAR(x) \
1912 CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x))
1913 2300
1914#define CHECK_CONS(x) \ 2301LISP_INLINE bool
1915 CHECK_TYPE (CONSP (x), Qconsp, x) 2302PROCESSP (Lisp_Object a)
2303{
2304 return PSEUDOVECTORP (a, PVEC_PROCESS);
2305}
1916 2306
1917#define CHECK_SYMBOL(x) \ 2307LISP_INLINE bool
1918 CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) 2308WINDOWP (Lisp_Object a)
2309{
2310 return PSEUDOVECTORP (a, PVEC_WINDOW);
2311}
1919 2312
1920#define CHECK_CHAR_TABLE(x) \ 2313LISP_INLINE bool
1921 CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) 2314TERMINALP (Lisp_Object a)
2315{
2316 return PSEUDOVECTORP (a, PVEC_TERMINAL);
2317}
1922 2318
1923#define CHECK_VECTOR(x) \ 2319LISP_INLINE bool
1924 CHECK_TYPE (VECTORP (x), Qvectorp, x) 2320SUBRP (Lisp_Object a)
2321{
2322 return PSEUDOVECTORP (a, PVEC_SUBR);
2323}
1925 2324
1926#define CHECK_VECTOR_OR_STRING(x) \ 2325LISP_INLINE bool
1927 CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) 2326COMPILEDP (Lisp_Object a)
2327{
2328 return PSEUDOVECTORP (a, PVEC_COMPILED);
2329}
1928 2330
1929#define CHECK_ARRAY(x, Qxxxp) \ 2331LISP_INLINE bool
1930 CHECK_TYPE (ARRAYP (x), Qxxxp, x) 2332BUFFERP (Lisp_Object a)
2333{
2334 return PSEUDOVECTORP (a, PVEC_BUFFER);
2335}
1931 2336
1932#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ 2337LISP_INLINE bool
1933 CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) 2338CHAR_TABLE_P (Lisp_Object a)
2339{
2340 return PSEUDOVECTORP (a, PVEC_CHAR_TABLE);
2341}
1934 2342
1935#define CHECK_BUFFER(x) \ 2343LISP_INLINE bool
1936 CHECK_TYPE (BUFFERP (x), Qbufferp, x) 2344SUB_CHAR_TABLE_P (Lisp_Object a)
2345{
2346 return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE);
2347}
1937 2348
1938#define CHECK_WINDOW(x) \ 2349LISP_INLINE bool
1939 CHECK_TYPE (WINDOWP (x), Qwindowp, x) 2350BOOL_VECTOR_P (Lisp_Object a)
2351{
2352 return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR);
2353}
1940 2354
1941#define CHECK_WINDOW_CONFIGURATION(x) \ 2355LISP_INLINE bool
1942 CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) 2356FRAMEP (Lisp_Object a)
2357{
2358 return PSEUDOVECTORP (a, PVEC_FRAME);
2359}
1943 2360
1944#define CHECK_PROCESS(x) \ 2361/* Test for image (image . spec) */
1945 CHECK_TYPE (PROCESSP (x), Qprocessp, x) 2362LISP_INLINE bool
2363IMAGEP (Lisp_Object x)
2364{
2365 return CONSP (x) && EQ (XCAR (x), Qimage);
2366}
1946 2367
1947#define CHECK_SUBR(x) \ 2368/* Array types. */
1948 CHECK_TYPE (SUBRP (x), Qsubrp, x) 2369LISP_INLINE bool
2370ARRAYP (Lisp_Object x)
2371{
2372 return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x);
2373}
2374
2375LISP_INLINE void
2376CHECK_LIST (Lisp_Object x)
2377{
2378 CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x);
2379}
1949 2380
1950#define CHECK_NUMBER(x) \ 2381LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y))
1951 CHECK_TYPE (INTEGERP (x), Qintegerp, x) 2382LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x))
2383LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x))
1952 2384
1953#define CHECK_NATNUM(x) \ 2385LISP_INLINE void
1954 CHECK_TYPE (NATNUMP (x), Qwholenump, x) 2386CHECK_STRING (Lisp_Object x)
2387{
2388 CHECK_TYPE (STRINGP (x), Qstringp, x);
2389}
2390LISP_INLINE void
2391CHECK_STRING_CAR (Lisp_Object x)
2392{
2393 CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
2394}
2395LISP_INLINE void
2396CHECK_CONS (Lisp_Object x)
2397{
2398 CHECK_TYPE (CONSP (x), Qconsp, x);
2399}
2400LISP_INLINE void
2401CHECK_VECTOR (Lisp_Object x)
2402{
2403 CHECK_TYPE (VECTORP (x), Qvectorp, x);
2404}
2405LISP_INLINE void
2406CHECK_VECTOR_OR_STRING (Lisp_Object x)
2407{
2408 CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
2409}
2410LISP_INLINE void
2411CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp)
2412{
2413 CHECK_TYPE (ARRAYP (x), Qxxxp, x);
2414}
2415LISP_INLINE void
2416CHECK_BUFFER (Lisp_Object x)
2417{
2418 CHECK_TYPE (BUFFERP (x), Qbufferp, x);
2419}
2420LISP_INLINE void
2421CHECK_WINDOW (Lisp_Object x)
2422{
2423 CHECK_TYPE (WINDOWP (x), Qwindowp, x);
2424}
2425LISP_INLINE void
2426CHECK_PROCESS (Lisp_Object x)
2427{
2428 CHECK_TYPE (PROCESSP (x), Qprocessp, x);
2429}
2430LISP_INLINE void
2431CHECK_NATNUM (Lisp_Object x)
2432{
2433 CHECK_TYPE (NATNUMP (x), Qwholenump, x);
2434}
1955 2435
1956#define CHECK_RANGED_INTEGER(x, lo, hi) \ 2436#define CHECK_RANGED_INTEGER(x, lo, hi) \
1957 do { \ 2437 do { \
@@ -1972,57 +2452,43 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
1972 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ 2452 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
1973 } while (0) 2453 } while (0)
1974 2454
1975#define CHECK_MARKER(x) \
1976 CHECK_TYPE (MARKERP (x), Qmarkerp, x)
1977
1978#define CHECK_NUMBER_COERCE_MARKER(x) \ 2455#define CHECK_NUMBER_COERCE_MARKER(x) \
1979 do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ 2456 do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
1980 else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) 2457 else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
1981 2458
1982#define XFLOATINT(n) extract_float((n)) 2459LISP_INLINE double
1983 2460XFLOATINT (Lisp_Object n)
1984#define CHECK_FLOAT(x) \ 2461{
1985 CHECK_TYPE (FLOATP (x), Qfloatp, x) 2462 return extract_float (n);
2463}
1986 2464
1987#define CHECK_NUMBER_OR_FLOAT(x) \ 2465LISP_INLINE void
1988 CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) 2466CHECK_NUMBER_OR_FLOAT (Lisp_Object x)
2467{
2468 CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x);
2469}
1989 2470
1990#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ 2471#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
1991 do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ 2472 do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \
1992 else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) 2473 else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
1993 2474
1994#define CHECK_OVERLAY(x) \
1995 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
1996
1997/* Since we can't assign directly to the CAR or CDR fields of a cons 2475/* Since we can't assign directly to the CAR or CDR fields of a cons
1998 cell, use these when checking that those fields contain numbers. */ 2476 cell, use these when checking that those fields contain numbers. */
1999#define CHECK_NUMBER_CAR(x) \ 2477LISP_INLINE void
2000 do { \ 2478CHECK_NUMBER_CAR (Lisp_Object x)
2001 Lisp_Object tmp = XCAR (x); \ 2479{
2002 CHECK_NUMBER (tmp); \ 2480 Lisp_Object tmp = XCAR (x);
2003 XSETCAR ((x), tmp); \ 2481 CHECK_NUMBER (tmp);
2004 } while (0) 2482 XSETCAR (x, tmp);
2005 2483}
2006#define CHECK_NUMBER_CDR(x) \
2007 do { \
2008 Lisp_Object tmp = XCDR (x); \
2009 CHECK_NUMBER (tmp); \
2010 XSETCDR ((x), tmp); \
2011 } while (0)
2012
2013#define CHECK_NATNUM_CAR(x) \
2014 do { \
2015 Lisp_Object tmp = XCAR (x); \
2016 CHECK_NATNUM (tmp); \
2017 XSETCAR ((x), tmp); \
2018 } while (0)
2019 2484
2020#define CHECK_NATNUM_CDR(x) \ 2485LISP_INLINE void
2021 do { \ 2486CHECK_NUMBER_CDR (Lisp_Object x)
2022 Lisp_Object tmp = XCDR (x); \ 2487{
2023 CHECK_NATNUM (tmp); \ 2488 Lisp_Object tmp = XCDR (x);
2024 XSETCDR ((x), tmp); \ 2489 CHECK_NUMBER (tmp);
2025 } while (0) 2490 XSETCDR (x, tmp);
2491}
2026 2492
2027/* Define a built-in function for calling from Lisp. 2493/* Define a built-in function for calling from Lisp.
2028 `lname' should be the name to give the function in Lisp, 2494 `lname' should be the name to give the function in Lisp,
@@ -2088,8 +2554,12 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
2088#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 2554#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
2089 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) 2555 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
2090 2556
2091/* Non-zero if OBJ is a Lisp function. */ 2557/* True if OBJ is a Lisp function. */
2092#define FUNCTIONP(OBJ) functionp(OBJ) 2558LISP_INLINE bool
2559FUNCTIONP (Lisp_Object obj)
2560{
2561 return functionp (obj);
2562}
2093 2563
2094/* defsubr (Sname); 2564/* defsubr (Sname);
2095 is how we define the symbol for function `name' at start-up time. */ 2565 is how we define the symbol for function `name' at start-up time. */
@@ -2245,38 +2715,15 @@ struct specbinding
2245 } v; 2715 } v;
2246 }; 2716 };
2247 2717
2248LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl)
2249{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; }
2250
2251LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl)
2252{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; }
2253
2254LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl)
2255{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; }
2256
2257LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl)
2258{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; }
2259
2260LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl)
2261{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; }
2262
2263LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl)
2264{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; }
2265
2266LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl)
2267{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; }
2268
2269LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl)
2270{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; }
2271
2272LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl)
2273{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; }
2274
2275extern struct specbinding *specpdl; 2718extern struct specbinding *specpdl;
2276extern struct specbinding *specpdl_ptr; 2719extern struct specbinding *specpdl_ptr;
2277extern ptrdiff_t specpdl_size; 2720extern ptrdiff_t specpdl_size;
2278 2721
2279#define SPECPDL_INDEX() (specpdl_ptr - specpdl) 2722LISP_INLINE ptrdiff_t
2723SPECPDL_INDEX (void)
2724{
2725 return specpdl_ptr - specpdl;
2726}
2280 2727
2281/* Everything needed to describe an active condition case. 2728/* Everything needed to describe an active condition case.
2282 2729
@@ -2592,27 +3039,12 @@ void staticpro (Lisp_Object *);
2592#define EXFUN(fnname, maxargs) \ 3039#define EXFUN(fnname, maxargs) \
2593 extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs 3040 extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
2594 3041
3042#include "globals.h"
3043
2595/* Forward declarations for prototypes. */ 3044/* Forward declarations for prototypes. */
2596struct window; 3045struct window;
2597struct frame; 3046struct frame;
2598 3047
2599/* Simple access functions. */
2600
2601LISP_INLINE Lisp_Object *
2602aref_addr (Lisp_Object array, ptrdiff_t idx)
2603{
2604 return & XVECTOR (array)->contents[idx];
2605}
2606
2607LISP_INLINE void
2608gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
2609{
2610 /* Like ASET, but also can be used in the garbage collector:
2611 sweep_weak_table calls set_hash_key etc. while the table is marked. */
2612 eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
2613 XVECTOR (array)->contents[idx] = val;
2614}
2615
2616/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ 3048/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
2617 3049
2618LISP_INLINE void 3050LISP_INLINE void
@@ -2625,12 +3057,6 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
2625/* Functions to modify hash tables. */ 3057/* Functions to modify hash tables. */
2626 3058
2627LISP_INLINE void 3059LISP_INLINE void
2628set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
2629{
2630 h->key_and_value = key_and_value;
2631}
2632
2633LISP_INLINE void
2634set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) 3060set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2635{ 3061{
2636 gc_aset (h->key_and_value, 2 * idx, val); 3062 gc_aset (h->key_and_value, 2 * idx, val);
@@ -2642,52 +3068,10 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2642 gc_aset (h->key_and_value, 2 * idx + 1, val); 3068 gc_aset (h->key_and_value, 2 * idx + 1, val);
2643} 3069}
2644 3070
2645LISP_INLINE void
2646set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
2647{
2648 h->next = next;
2649}
2650
2651LISP_INLINE void
2652set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2653{
2654 gc_aset (h->next, idx, val);
2655}
2656
2657LISP_INLINE void
2658set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
2659{
2660 h->hash = hash;
2661}
2662
2663LISP_INLINE void
2664set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2665{
2666 gc_aset (h->hash, idx, val);
2667}
2668
2669LISP_INLINE void
2670set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
2671{
2672 h->index = index;
2673}
2674
2675LISP_INLINE void
2676set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2677{
2678 gc_aset (h->index, idx, val);
2679}
2680
2681/* Use these functions to set Lisp_Object 3071/* Use these functions to set Lisp_Object
2682 or pointer slots of struct Lisp_Symbol. */ 3072 or pointer slots of struct Lisp_Symbol. */
2683 3073
2684LISP_INLINE void 3074LISP_INLINE void
2685set_symbol_name (Lisp_Object sym, Lisp_Object name)
2686{
2687 XSYMBOL (sym)->name = name;
2688}
2689
2690LISP_INLINE void
2691set_symbol_function (Lisp_Object sym, Lisp_Object function) 3075set_symbol_function (Lisp_Object sym, Lisp_Object function)
2692{ 3076{
2693 XSYMBOL (sym)->function = function; 3077 XSYMBOL (sym)->function = function;
@@ -2714,43 +3098,6 @@ blv_found (struct Lisp_Buffer_Local_Value *blv)
2714 return blv->found; 3098 return blv->found;
2715} 3099}
2716 3100
2717LISP_INLINE void
2718set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
2719{
2720 eassert (found == !EQ (blv->defcell, blv->valcell));
2721 blv->found = found;
2722}
2723
2724LISP_INLINE Lisp_Object
2725blv_value (struct Lisp_Buffer_Local_Value *blv)
2726{
2727 return XCDR (blv->valcell);
2728}
2729
2730LISP_INLINE void
2731set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2732{
2733 XSETCDR (blv->valcell, val);
2734}
2735
2736LISP_INLINE void
2737set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2738{
2739 blv->where = val;
2740}
2741
2742LISP_INLINE void
2743set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2744{
2745 blv->defcell = val;
2746}
2747
2748LISP_INLINE void
2749set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2750{
2751 blv->valcell = val;
2752}
2753
2754/* Set overlay's property list. */ 3101/* Set overlay's property list. */
2755 3102
2756LISP_INLINE void 3103LISP_INLINE void
@@ -2779,21 +3126,11 @@ set_string_intervals (Lisp_Object s, INTERVAL i)
2779 of setting slots directly. */ 3126 of setting slots directly. */
2780 3127
2781LISP_INLINE void 3128LISP_INLINE void
2782set_char_table_ascii (Lisp_Object table, Lisp_Object val)
2783{
2784 XCHAR_TABLE (table)->ascii = val;
2785}
2786LISP_INLINE void
2787set_char_table_defalt (Lisp_Object table, Lisp_Object val) 3129set_char_table_defalt (Lisp_Object table, Lisp_Object val)
2788{ 3130{
2789 XCHAR_TABLE (table)->defalt = val; 3131 XCHAR_TABLE (table)->defalt = val;
2790} 3132}
2791LISP_INLINE void 3133LISP_INLINE void
2792set_char_table_parent (Lisp_Object table, Lisp_Object val)
2793{
2794 XCHAR_TABLE (table)->parent = val;
2795}
2796LISP_INLINE void
2797set_char_table_purpose (Lisp_Object table, Lisp_Object val) 3134set_char_table_purpose (Lisp_Object table, Lisp_Object val)
2798{ 3135{
2799 XCHAR_TABLE (table)->purpose = val; 3136 XCHAR_TABLE (table)->purpose = val;
@@ -3237,7 +3574,7 @@ extern int valid_lisp_object_p (Lisp_Object);
3237#ifdef GC_CHECK_CONS_LIST 3574#ifdef GC_CHECK_CONS_LIST
3238extern void check_cons_list (void); 3575extern void check_cons_list (void);
3239#else 3576#else
3240#define check_cons_list() ((void) 0) 3577LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
3241#endif 3578#endif
3242 3579
3243#ifdef REL_ALLOC 3580#ifdef REL_ALLOC
@@ -3305,10 +3642,12 @@ extern Lisp_Object check_obarray (Lisp_Object);
3305extern Lisp_Object intern_1 (const char *, ptrdiff_t); 3642extern Lisp_Object intern_1 (const char *, ptrdiff_t);
3306extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); 3643extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
3307extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); 3644extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
3308#define LOADHIST_ATTACH(x) \ 3645LISP_INLINE void
3309 do { \ 3646LOADHIST_ATTACH (Lisp_Object x)
3310 if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ 3647{
3311 } while (0) 3648 if (initialized)
3649 Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
3650}
3312extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, 3651extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
3313 Lisp_Object *, Lisp_Object); 3652 Lisp_Object *, Lisp_Object);
3314extern Lisp_Object string_to_number (char const *, int, bool); 3653extern Lisp_Object string_to_number (char const *, int, bool);
@@ -3594,10 +3933,9 @@ void fixup_locale (void);
3594void synchronize_system_messages_locale (void); 3933void synchronize_system_messages_locale (void);
3595void synchronize_system_time_locale (void); 3934void synchronize_system_time_locale (void);
3596#else 3935#else
3597#define setlocale(category, locale) 3936LISP_INLINE void fixup_locale (void) {}
3598#define fixup_locale() 3937LISP_INLINE void synchronize_system_messages_locale (void) {}
3599#define synchronize_system_messages_locale() 3938LISP_INLINE void synchronize_system_time_locale (void) {}
3600#define synchronize_system_time_locale()
3601#endif 3939#endif
3602extern void shut_down_emacs (int, Lisp_Object); 3940extern void shut_down_emacs (int, Lisp_Object);
3603 3941
@@ -3956,8 +4294,6 @@ extern void *record_xmalloc (size_t);
3956 } while (0) 4294 } while (0)
3957 4295
3958 4296
3959#include "globals.h"
3960
3961/* Check whether it's time for GC, and run it if so. */ 4297/* Check whether it's time for GC, and run it if so. */
3962 4298
3963LISP_INLINE void 4299LISP_INLINE void
@@ -3970,7 +4306,7 @@ maybe_gc (void)
3970 Fgarbage_collect (); 4306 Fgarbage_collect ();
3971} 4307}
3972 4308
3973LISP_INLINE int 4309LISP_INLINE bool
3974functionp (Lisp_Object object) 4310functionp (Lisp_Object object)
3975{ 4311{
3976 if (SYMBOLP (object) && !NILP (Ffboundp (object))) 4312 if (SYMBOLP (object) && !NILP (Ffboundp (object)))
diff --git a/src/marker.c b/src/marker.c
index 63027d3be5e..6c50def51a3 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -127,6 +127,12 @@ clear_charpos_cache (struct buffer *b)
127 } \ 127 } \
128} 128}
129 129
130static void
131CHECK_MARKER (Lisp_Object x)
132{
133 CHECK_TYPE (MARKERP (x), Qmarkerp, x);
134}
135
130/* Return the byte position corresponding to CHARPOS in B. */ 136/* Return the byte position corresponding to CHARPOS in B. */
131 137
132ptrdiff_t 138ptrdiff_t
diff --git a/src/textprop.c b/src/textprop.c
index cc364d5a38c..03b8de120cd 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -98,6 +98,14 @@ modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
98 set_buffer_internal (old); 98 set_buffer_internal (old);
99} 99}
100 100
101/* Complain if object is not string or buffer type. */
102
103static void
104CHECK_STRING_OR_BUFFER (Lisp_Object x)
105{
106 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
107}
108
101/* Extract the interval at the position pointed to by BEGIN from 109/* Extract the interval at the position pointed to by BEGIN from
102 OBJECT, a string or buffer. Additionally, check that the positions 110 OBJECT, a string or buffer. Additionally, check that the positions
103 pointed to by BEGIN and END are within the bounds of OBJECT, and 111 pointed to by BEGIN and END are within the bounds of OBJECT, and
diff --git a/src/window.c b/src/window.c
index 28e01103eb1..76432f8bb6b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -55,7 +55,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
55 55
56Lisp_Object Qwindowp, Qwindow_live_p; 56Lisp_Object Qwindowp, Qwindow_live_p;
57static Lisp_Object Qwindow_valid_p; 57static Lisp_Object Qwindow_valid_p;
58static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; 58static Lisp_Object Qwindow_configuration_p;
59static Lisp_Object Qrecord_window_buffer;
59static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; 60static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer;
60static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; 61static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window;
61static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; 62static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically;
@@ -130,6 +131,12 @@ static int window_scroll_pixel_based_preserve_y;
130static EMACS_INT window_scroll_preserve_hpos; 131static EMACS_INT window_scroll_preserve_hpos;
131static EMACS_INT window_scroll_preserve_vpos; 132static EMACS_INT window_scroll_preserve_vpos;
132 133
134static void
135CHECK_WINDOW_CONFIGURATION (Lisp_Object x)
136{
137 CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x);
138}
139
133/* These setters are used only in this file, so they can be private. */ 140/* These setters are used only in this file, so they can be private. */
134static void 141static void
135wset_combination_limit (struct window *w, Lisp_Object val) 142wset_combination_limit (struct window *w, Lisp_Object val)
diff --git a/src/window.h b/src/window.h
index 411756f045e..846831e43d5 100644
--- a/src/window.h
+++ b/src/window.h
@@ -958,7 +958,7 @@ struct glyph *get_phys_cursor_glyph (struct window *w);
958 958
959/* These used to be in lisp.h. */ 959/* These used to be in lisp.h. */
960 960
961extern Lisp_Object Qwindowp, Qwindow_live_p; 961extern Lisp_Object Qwindow_live_p;
962extern Lisp_Object Vwindow_list; 962extern Lisp_Object Vwindow_list;
963 963
964extern struct window *decode_live_window (Lisp_Object); 964extern struct window *decode_live_window (Lisp_Object);