X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/294180317b6417c54618d4822c19bc0809c2bc7a..ba7762b393919972d877b252fe3e1f660a506f6b:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index ca44ab9810..7d9951b8b7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -297,13 +297,16 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG) #define lisp_h_INTEGERP(x) (SCM_I_INUMP (x)) #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define lisp_h_MISCP(x) (SMOB_TYPEP (x, lisp_misc_tag)) -#define lisp_h_NILP(x) EQ (x, Qnil) +#define lisp_h_NILP(x) (scm_is_lisp_false (x)) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) + (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \ + scm_c_vector_set_x (sym, 4, v)) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYMBOL_CONSTANT (XSYMBOL (sym))) #define lisp_h_SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) -#define lisp_h_SYMBOLP(x) (x && scm_is_symbol (x)) + (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \ + scm_c_vector_ref (sym, 4)) +#define lisp_h_SYMBOLP(x) \ + (x && (scm_is_symbol (x) || EQ (x, Qnil) || EQ (x, Qt))) #define lisp_h_VECTORLIKEP(x) (SMOB_TYPEP (x, lisp_vectorlike_tag)) #define lisp_h_XCAR(c) (scm_car (c)) #define lisp_h_XCDR(c) (scm_cdr (c)) @@ -439,7 +442,6 @@ enum pvec_type PVEC_HASH_TABLE, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, - PVEC_SUBR, PVEC_OTHER, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, @@ -565,7 +567,6 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); INLINE bool STRINGP (Lisp_Object); INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); -INLINE bool SUBRP (Lisp_Object); INLINE bool (SYMBOLP) (Lisp_Object); INLINE bool (VECTORLIKEP) (Lisp_Object); INLINE bool WINDOWP (Lisp_Object); @@ -649,15 +650,11 @@ INLINE Lisp_Object build_string (const char *); extern Lisp_Object symbol_module; extern Lisp_Object function_module; extern Lisp_Object plist_module; +extern Lisp_Object Qt, Qnil, Qt_, Qnil_; -INLINE struct Lisp_Symbol * -XSYMBOL (Lisp_Object a) -{ - Lisp_Object tem; - eassert (SYMBOLP (a)); - tem = scm_variable_ref (scm_module_lookup (symbol_module, a)); - return scm_to_pointer (tem); -} +typedef Lisp_Object sym_t; + +INLINE sym_t XSYMBOL (Lisp_Object a); /* Pseudovector types. */ @@ -681,13 +678,6 @@ XTERMINAL (Lisp_Object a) return SMOB_PTR (a); } -INLINE struct Lisp_Subr * -XSUBR (Lisp_Object a) -{ - eassert (SUBRP (a)); - return SMOB_PTR (a); -} - INLINE struct buffer * XBUFFER (Lisp_Object a) { @@ -716,18 +706,13 @@ XBOOL_VECTOR (Lisp_Object a) return SMOB_PTR (a); } -INLINE Lisp_Object -make_lisp_proc (struct Lisp_Process *p) -{ - return scm_new_smob (lisp_vectorlike_tag, (scm_t_bits) p); -} - #define XSETINT(a, b) ((a) = make_number (b)) #define XSETFASTINT(a, b) ((a) = make_natnum (b)) #define XSETVECTOR(a, b) ((a) = (b)->header.self) #define XSETSTRING(a, b) ((a) = (b)->self) -#define XSETSYMBOL(a, b) ((a) = (b)->self) +#define XSETSYMBOL(a, b) ((a) = scm_c_vector_ref (b, 0)) #define XSETMISC(a, b) (a) = ((union Lisp_Misc *) (b))->u_any.self +#define make_lisp_proc(p) ((p)->header.self) /* Pseudovector types. */ @@ -777,6 +762,14 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE, typedef struct interval *INTERVAL; +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; + LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c)) LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c)) @@ -825,15 +818,6 @@ CDR_SAFE (Lisp_Object c) /* In a string or vector, the sign bit of the `size' is the gc mark bit. */ -struct Lisp_String - { - Lisp_Object self; - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; - /* True if STR is a multibyte string. */ INLINE bool STRING_MULTIBYTE (Lisp_Object str) @@ -1236,32 +1220,6 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) char_table_set (ct, idx, val); } -/* This structure describes a built-in function. - It is generated by the DEFUN macro only. - defsubr makes it into a Lisp object. */ - -struct Lisp_Subr - { - struct vectorlike_header header; - union { - Lisp_Object (*a0) (void); - Lisp_Object (*a1) (Lisp_Object); - Lisp_Object (*a2) (Lisp_Object, Lisp_Object); - Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*aUNEVALLED) (Lisp_Object args); - Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *); - } function; - short min_args, max_args; - const char *symbol_name; - const char *intspec; - const char *doc; - }; - /* This is the number of slots that every char table must have. This counts the ordinary slots and the top, defalt, parent, and purpose slots. */ @@ -1284,15 +1242,6 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) Symbols ***********************************************************************/ -/* Interned state of a symbol. */ - -enum symbol_interned -{ - SYMBOL_UNINTERNED = 0, - SYMBOL_INTERNED = 1, - SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 -}; - enum symbol_redirect { SYMBOL_PLAINVAL = 4, @@ -1303,93 +1252,90 @@ enum symbol_redirect struct Lisp_Symbol { - Lisp_Object self; + Lisp_Object self_; /* Indicates where the value can be found: 0 : it's a plain var, the value is in the `value' field. 1 : it's a varalias, the value is really in the `alias' symbol. 2 : it's a localized var, the value is in the `blv' object. 3 : it's a forwarding variable, the value is in `forward'. */ - ENUM_BF (symbol_redirect) redirect : 3; + ENUM_BF (symbol_redirect) redirect_ : 3; /* Non-zero means symbol is constant, i.e. changing its value should signal an error. If the value is 3, then the var can be changed, but only by `defconst'. */ - unsigned constant : 2; - - /* Interned state of the symbol. This is an enumerator from - enum symbol_interned. */ - unsigned interned : 2; + unsigned constant_ : 2; /* True means that this variable has been explicitly declared special (with `defvar' etc), and shouldn't be lexically bound. */ - bool_bf declared_special : 1; - - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - - /* The symbol's name, as a Lisp string. */ - Lisp_Object name; + bool_bf declared_special_ : 1; /* Value of the symbol or Qunbound if unbound. Which alternative of the union is used depends on the `redirect' field above. */ union { - Lisp_Object value; - struct Lisp_Symbol *alias; - struct Lisp_Buffer_Local_Value *blv; - union Lisp_Fwd *fwd; - } val; + Lisp_Object value_; + sym_t alias_; + struct Lisp_Buffer_Local_Value *blv_; + union Lisp_Fwd *fwd_; + }; }; -/* Value is name of symbol. */ +#define SYMBOL_SELF(sym) (scm_c_vector_ref (sym, 0)) +#define SET_SYMBOL_SELF(sym, v) (scm_c_vector_set_x (sym, 0, v)) +#define SYMBOL_REDIRECT(sym) (XINT (scm_c_vector_ref (sym, 1))) +#define SET_SYMBOL_REDIRECT(sym, v) (scm_c_vector_set_x (sym, 1, make_number (v))) +#define SYMBOL_CONSTANT(sym) (XINT (scm_c_vector_ref (sym, 2))) +#define SET_SYMBOL_CONSTANT(sym, v) (scm_c_vector_set_x (sym, 2, make_number (v))) +#define SYMBOL_DECLARED_SPECIAL(sym) (XINT (scm_c_vector_ref (sym, 3))) +#define SET_SYMBOL_DECLARED_SPECIAL(sym, v) (scm_c_vector_set_x (sym, 3, make_number (v))) -LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) +/* Value is name of symbol. */ -INLINE struct Lisp_Symbol * -SYMBOL_ALIAS (struct Lisp_Symbol *sym) +INLINE sym_t +SYMBOL_ALIAS (sym_t sym) { - eassert (sym->redirect == SYMBOL_VARALIAS); - return sym->val.alias; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS); + return scm_c_vector_ref (sym, 4); } INLINE struct Lisp_Buffer_Local_Value * -SYMBOL_BLV (struct Lisp_Symbol *sym) +SYMBOL_BLV (sym_t sym) { - eassert (sym->redirect == SYMBOL_LOCALIZED); - return sym->val.blv; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED); + return scm_to_pointer (scm_c_vector_ref (sym, 4)); } INLINE union Lisp_Fwd * -SYMBOL_FWD (struct Lisp_Symbol *sym) +SYMBOL_FWD (sym_t sym) { - eassert (sym->redirect == SYMBOL_FORWARDED); - return sym->val.fwd; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED); + return scm_to_pointer (scm_c_vector_ref (sym, 4)); } LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL, - (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v)) + (sym_t sym, Lisp_Object v), (sym, v)) INLINE void -SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +SET_SYMBOL_ALIAS (sym_t sym, sym_t v) { - eassert (sym->redirect == SYMBOL_VARALIAS); - sym->val.alias = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS); + scm_c_vector_set_x (sym, 4, v); } INLINE void -SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +SET_SYMBOL_BLV (sym_t sym, struct Lisp_Buffer_Local_Value *v) { - eassert (sym->redirect == SYMBOL_LOCALIZED); - sym->val.blv = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED); + scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL)); } INLINE void -SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +SET_SYMBOL_FWD (sym_t sym, union Lisp_Fwd *v) { - eassert (sym->redirect == SYMBOL_FORWARDED); - sym->val.fwd = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED); + scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL)); } INLINE Lisp_Object SYMBOL_NAME (Lisp_Object sym) { - return XSYMBOL (sym)->name; + return build_string (scm_to_locale_string (scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-name"), sym))); } /* Value is true if SYM is an interned symbol. */ @@ -1397,21 +1343,21 @@ SYMBOL_NAME (Lisp_Object sym) INLINE bool SYMBOL_INTERNED_P (Lisp_Object sym) { - return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; + if (EQ (sym, Qnil)) return true; + if (EQ (sym, Qt)) return true; + return scm_is_true (scm_symbol_interned_p (sym)); } -/* Value is true if SYM is interned in initial_obarray. */ - -INLINE bool -SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) -{ - return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; -} +extern Lisp_Object Ffboundp (Lisp_Object); +extern Lisp_Object Fmakunbound (Lisp_Object); +extern Lisp_Object Ffmakunbound (Lisp_Object); +extern Lisp_Object Ffset (Lisp_Object, Lisp_Object); +extern Lisp_Object Fsymbol_function (Lisp_Object); INLINE Lisp_Object SYMBOL_FUNCTION (Lisp_Object sym) { - return scm_variable_ref (scm_module_lookup (function_module, sym)); + return Fsymbol_function (sym); } /* Value is non-zero if symbol is considered a constant, i.e. its @@ -1423,6 +1369,8 @@ LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false) +LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (sym_t sym), (sym)) + /*********************************************************************** Hash Tables @@ -2148,12 +2096,6 @@ TERMINALP (Lisp_Object a) return PSEUDOVECTORP (a, PVEC_TERMINAL); } -INLINE bool -SUBRP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_SUBR); -} - INLINE bool COMPILEDP (Lisp_Object a) { @@ -2364,28 +2306,71 @@ CHECK_NUMBER_CDR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#ifdef _MSC_VER #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - SCM_SNARF_INIT (defsubr (&sname);) \ + SCM_SNARF_INIT (defsubr (lname, gsubr_ ## fnname, minargs, maxargs, intspec)) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { { NULL, \ - (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ - | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ - { (Lisp_Object (__cdecl *)(void))fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ + DEFUN_GSUBR_ ## maxargs (lname, fnname, minargs, maxargs) \ Lisp_Object fnname -#else /* not _MSC_VER */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - SCM_SNARF_INIT (defsubr (&sname);) \ - Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { { .self = NULL, \ - .size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ - Lisp_Object fnname -#endif + +#define GSUBR_ARGS_1(f) f (arg1) +#define GSUBR_ARGS_2(f) GSUBR_ARGS_1 (f), f (arg2) +#define GSUBR_ARGS_3(f) GSUBR_ARGS_2 (f), f (arg3) +#define GSUBR_ARGS_4(f) GSUBR_ARGS_3 (f), f (arg4) +#define GSUBR_ARGS_5(f) GSUBR_ARGS_4 (f), f (arg5) +#define GSUBR_ARGS_6(f) GSUBR_ARGS_5 (f), f (arg6) +#define GSUBR_ARGS_7(f) GSUBR_ARGS_6 (f), f (arg7) +#define GSUBR_ARGS_8(f) GSUBR_ARGS_7 (f), f (arg8) + +#define GSUBR_ARGS(n) GSUBR_ARGS_PASTE (GSUBR_ARGS_, n) +#define GSUBR_ARGS_PASTE(a, b) a ## b + +#define DEFUN_GSUBR_N(fn, maxargs) \ + Lisp_Object \ + gsubr_ ## fn \ + (GSUBR_ARGS (maxargs) (Lisp_Object)) \ + { \ + return fn (GSUBR_ARGS (maxargs) (GSUBR_ARG)); \ + } +#define GSUBR_ARG(x) (SCM_UNBNDP (x) ? Qnil : x) + +#define DEFUN_GSUBR_0(lname, fn, minargs, maxargs) \ + Lisp_Object gsubr_ ## fn (void) { return fn (); } +#define DEFUN_GSUBR_1(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_2(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_3(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_4(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_5(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_6(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_7(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_8(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) + +#define DEFUN_GSUBR_UNEVALLED(lname, fn, minargs, maxargs) \ + Lisp_Object \ + gsubr_ ## fn (Lisp_Object rest) \ + { \ + Lisp_Object len = Flength (rest); \ + if (XINT (len) < minargs) \ + xsignal2 (Qwrong_number_of_arguments, \ + intern (lname), len); \ + return fn (rest); \ + } +#define DEFUN_GSUBR_MANY(lname, fn, minargs, maxargs) \ + Lisp_Object \ + gsubr_ ## fn (Lisp_Object rest) \ + { \ + int len = scm_to_int (scm_length (rest)); \ + Lisp_Object *args; \ + SAFE_ALLOCA_LISP (args, len); \ + int i; \ + for (i = 0; \ + i < len && scm_is_pair (rest); \ + i++, rest = SCM_CDR (rest)) \ + args[i] = SCM_CAR (rest); \ + if (i < minargs) \ + xsignal2 (Qwrong_number_of_arguments, \ + intern (lname), make_number (i)); \ + return fn (i, args); \ + } /* Note that the weird token-substitution semantics of ANSI C makes this work for MANY and UNEVALLED. */ @@ -2405,6 +2390,13 @@ CHECK_NUMBER_CDR (Lisp_Object x) #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) +#define WRAP1(cfn, lfn) \ + SCM_SNARF_INIT (DEFSYM (cfn ## _sym, lfn)) \ + static Lisp_Object cfn ## _sym; \ + Lisp_Object cfn (Lisp_Object a) \ + { return call1 (cfn ## _sym, a); } +#define WRAP2(cfn, lfn) Lisp_Object cfn (Lisp_Object a, Lisp_Object b) { return call2 (intern (lfn), a, b); } + /* True if OBJ is a Lisp function. */ INLINE bool FUNCTIONP (Lisp_Object obj) @@ -2414,7 +2406,7 @@ FUNCTIONP (Lisp_Object obj) /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ -extern void defsubr (struct Lisp_Subr *); +extern void defsubr (const char *, scm_t_subr, short, short, const char *); enum maxargs { @@ -2520,7 +2512,6 @@ typedef jmp_buf sys_jmp_buf; union specbinding. But only eval.c should access it. */ enum specbind_tag { - SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */ SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */ @@ -2612,7 +2603,6 @@ struct handler Lisp_Object body; struct handler *next; EMACS_INT lisp_eval_depth; - int poll_suppress_count; int interrupt_input_blocked; }; @@ -2758,19 +2748,22 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { - scm_variable_set_x (scm_module_lookup (function_module, sym), function); + scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-function!"), + sym, function); } INLINE Lisp_Object symbol_plist (Lisp_Object sym) { - return scm_variable_ref (scm_module_lookup (plist_module, sym)); + return scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-plist"), + sym); } INLINE void set_symbol_plist (Lisp_Object sym, Lisp_Object plist) { - scm_variable_set_x (scm_module_lookup (plist_module, sym), plist); + scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-plist!"), + sym, plist); } /* Buffer-local (also frame-local) variable access functions. */ @@ -2843,6 +2836,7 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) } /* Defined in data.c. */ +extern Lisp_Object Qnil_, Qt_; extern Lisp_Object Qquote, Qunbound; extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; extern Lisp_Object Qerror, Qquit, Qargs_out_of_range; @@ -2857,6 +2851,7 @@ extern Lisp_Object Qcircular_list; extern Lisp_Object Qsequencep; extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p; extern Lisp_Object Qfboundp; +extern Lisp_Object Qspecial_operator; extern Lisp_Object Qcdr; @@ -2908,14 +2903,14 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); -extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); +extern sym_t indirect_variable (sym_t ); extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); extern void syms_of_data (void); -extern void swap_in_global_binding (struct Lisp_Symbol *); +extern void swap_in_global_binding (sym_t ); /* Defined in cmds.c */ extern void syms_of_cmds (void); @@ -3108,7 +3103,7 @@ extern void memory_warnings (void *, void (*warnfun) (const char *)); /* Defined in alloc.c. */ extern void check_pure_size (void); extern void free_misc (Lisp_Object); -extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); +extern void allocate_string_data (Lisp_Object, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); extern _Noreturn void buffer_memory_full (ptrdiff_t); @@ -3307,7 +3302,6 @@ extern Lisp_Object check_obarray (Lisp_Object); extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object obhash (Lisp_Object); -extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); INLINE void LOADHIST_ATTACH (Lisp_Object x) { @@ -3406,12 +3400,8 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); extern void unwind_body (Lisp_Object); -extern void record_in_backtrace (Lisp_Object function, - Lisp_Object *args, ptrdiff_t nargs); extern void mark_specpdl (void); -extern void get_backtrace (Lisp_Object array); -Lisp_Object backtrace_top_function (void); -extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +extern bool let_shadows_buffer_binding_p (sym_t symbol); extern bool let_shadows_global_binding_p (Lisp_Object symbol); extern _Noreturn SCM abort_to_prompt (SCM, SCM); extern SCM call_with_prompt (SCM, SCM, SCM); @@ -3984,6 +3974,8 @@ maybe_gc (void) return; } +extern Lisp_Object Ffboundp (Lisp_Object); + INLINE bool functionp (Lisp_Object object) { @@ -4003,8 +3995,8 @@ functionp (Lisp_Object object) } } - if (SUBRP (object)) - return XSUBR (object)->max_args != UNEVALLED; + if (scm_is_true (scm_procedure_p (object))) + return 1; else if (COMPILEDP (object)) return true; else if (CONSP (object)) @@ -4016,5 +4008,13 @@ functionp (Lisp_Object object) return false; } +extern Lisp_Object xsymbol_fn; + +INLINE sym_t +XSYMBOL (Lisp_Object a) +{ + return scm_call_1 (xsymbol_fn, a); +} + INLINE_HEADER_END #endif /* EMACS_LISP_H */