X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/42808ce355255d8e614e5ee5cf195305a9bab4fd..efdd2e5c64957ecd43765763ab59edda56127b08:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index 7ea21221f8..38d5d3cdd0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -297,51 +297,18 @@ 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) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) -#define lisp_h_SYMBOLP(x) (SMOB_TYPEP (x, lisp_symbol_tag)) +#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)) #define lisp_h_XHASH(a) (SCM_UNPACK (a)) -#define lisp_h_XSYMBOL(a) \ - (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) SMOB_PTR (a)) - -/* When compiling via gcc -O0, define the key operations as macros, as - Emacs is too slow otherwise. To disable this optimization, compile - with -DINLINING=false. */ -#if 0 -#if (defined __NO_INLINE__ \ - && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ - && ! (defined INLINING && ! INLINING)) -# define XLI(o) lisp_h_XLI (o) -# define XIL(i) lisp_h_XIL (i) -# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) -# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) -# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) -# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) -# define CONSP(x) lisp_h_CONSP (x) -# define EQ(x, y) lisp_h_EQ (x, y) -# define FLOATP(x) lisp_h_FLOATP (x) -# define INTEGERP(x) lisp_h_INTEGERP (x) -# define MARKERP(x) lisp_h_MARKERP (x) -# define MISCP(x) lisp_h_MISCP (x) -# define NILP(x) lisp_h_NILP (x) -# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) -# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) -# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -# define SYMBOLP(x) lisp_h_SYMBOLP (x) -# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) -# define XCAR(c) lisp_h_XCAR (c) -# define XCDR(c) lisp_h_XCDR (c) -# define XHASH(a) lisp_h_XHASH (a) -# define XSYMBOL(a) lisp_h_XSYMBOL (a) -#endif -#endif /* Define NAME as a lisp.h inline function that returns TYPE and has arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and @@ -374,13 +341,14 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG) #define ENUM_BF(TYPE) enum TYPE #endif -scm_t_bits lisp_symbol_tag; scm_t_bits lisp_misc_tag; scm_t_bits lisp_string_tag; scm_t_bits lisp_vectorlike_tag; enum Lisp_Type { + Lisp_Other, + /* Integer. XINT (obj) is the integer value. */ Lisp_Int, @@ -472,7 +440,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, @@ -598,7 +565,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); @@ -658,7 +624,7 @@ XTYPE (Lisp_Object o) else if (FLOATP (o)) return Lisp_Float; else - abort (); + return Lisp_Other; } /* Extract a value or address from a Lisp_Object. */ @@ -677,7 +643,23 @@ XSTRING (Lisp_Object a) return SMOB_PTR (a); } -LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) +extern void initialize_symbol (Lisp_Object, Lisp_Object); +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; + if (EQ (a, Qt)) a = Qt_; + if (EQ (a, Qnil)) a = Qnil_; + eassert (SYMBOLP (a)); + tem = scm_variable_ref (scm_module_lookup (symbol_module, a)); + return scm_to_pointer (tem); +} /* Pseudovector types. */ @@ -701,13 +683,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) { @@ -1256,32 +1231,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. */ @@ -1304,15 +1253,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, @@ -1337,10 +1277,6 @@ struct Lisp_Symbol 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; - /* True means that this variable has been explicitly declared special (with `defvar' etc), and shouldn't be lexically bound. */ bool_bf declared_special : 1; @@ -1348,9 +1284,6 @@ struct Lisp_Symbol /* 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; - /* Value of the symbol or Qunbound if unbound. Which alternative of the union is used depends on the `redirect' field above. */ union { @@ -1359,15 +1292,6 @@ struct Lisp_Symbol struct Lisp_Buffer_Local_Value *blv; union Lisp_Fwd *fwd; } val; - - /* Function value of the symbol or Qnil if not fboundp. */ - Lisp_Object function; - - /* The symbol's property list. */ - Lisp_Object plist; - - /* Next symbol in obarray bucket, if the symbol is interned. */ - struct Lisp_Symbol *next; }; /* Value is name of symbol. */ @@ -1418,7 +1342,9 @@ SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) INLINE Lisp_Object SYMBOL_NAME (Lisp_Object sym) { - return XSYMBOL (sym)->name; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return build_string (scm_to_locale_string (scm_symbol_to_string (sym))); } /* Value is true if SYM is an interned symbol. */ @@ -1426,15 +1352,17 @@ SYMBOL_NAME (Lisp_Object sym) INLINE bool SYMBOL_INTERNED_P (Lisp_Object sym) { - return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + 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) +INLINE Lisp_Object +SYMBOL_FUNCTION (Lisp_Object sym) { - return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return scm_variable_ref (scm_module_lookup (function_module, sym)); } /* Value is non-zero if symbol is considered a constant, i.e. its @@ -2171,12 +2099,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) { @@ -2387,28 +2309,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);) \ - 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}; \ - Lisp_Object fnname -#else /* not _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 = \ - { { .self = NULL, \ - .size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ + DEFUN_GSUBR_ ## maxargs (lname, fnname, minargs, maxargs) \ 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. */ @@ -2437,7 +2402,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 { @@ -2543,10 +2508,6 @@ typedef jmp_buf sys_jmp_buf; union specbinding. But only eval.c should access it. */ enum specbind_tag { - SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ - SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ - SPECPDL_UNWIND_INT, /* Likewise, on int. */ - SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ 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. */ @@ -2559,21 +2520,28 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + } frame; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (Lisp_Object); Lisp_Object arg; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void *); void *arg; } unwind_ptr; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (int); int arg; } unwind_int; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void); } unwind_void; struct { @@ -2625,53 +2593,16 @@ enum handlertype { CATCHER, CONDITION_CASE }; struct handler { enum handlertype type; + Lisp_Object ptag; Lisp_Object tag_or_ch; Lisp_Object val; + Lisp_Object var; + Lisp_Object body; struct handler *next; - struct handler *nextfree; - - /* The bytecode interpreter can have several handlers active at the same - time, so when we longjmp to one of them, it needs to know which handler - this was and what was the corresponding internal state. This is stored - here, and when we longjmp we make sure that handlerlist points to the - proper handler. */ - Lisp_Object *bytecode_top; - int bytecode_dest; - - /* Most global vars are reset to their value via the specpdl mechanism, - but a few others are handled by storing their value here. */ -#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */ - struct gcpro *gcpro; -#endif - sys_jmp_buf jmp; EMACS_INT lisp_eval_depth; - ptrdiff_t pdlcount; - int poll_suppress_count; int interrupt_input_blocked; }; -/* Fill in the components of c, and put it on the list. */ -#define PUSH_HANDLER(c, tag_ch_val, handlertype) \ - if (handlerlist->nextfree) \ - (c) = handlerlist->nextfree; \ - else \ - { \ - (c) = xmalloc (sizeof (struct handler)); \ - (c)->nextfree = NULL; \ - handlerlist->nextfree = (c); \ - } \ - (c)->type = (handlertype); \ - (c)->tag_or_ch = (tag_ch_val); \ - (c)->val = Qnil; \ - (c)->next = handlerlist; \ - (c)->lisp_eval_depth = lisp_eval_depth; \ - (c)->pdlcount = SPECPDL_INDEX (); \ - (c)->poll_suppress_count = poll_suppress_count; \ - (c)->interrupt_input_blocked = interrupt_input_blocked;\ - (c)->gcpro = gcprolist; \ - handlerlist = (c); - - extern Lisp_Object memory_signal_data; /* Check quit-flag and quit if it is non-nil. @@ -2814,19 +2745,25 @@ 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) { - XSYMBOL (sym)->function = function; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + scm_variable_set_x (scm_module_lookup (function_module, sym), function); } -INLINE void -set_symbol_plist (Lisp_Object sym, Lisp_Object plist) +INLINE Lisp_Object +symbol_plist (Lisp_Object sym) { - XSYMBOL (sym)->plist = plist; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return scm_variable_ref (scm_module_lookup (plist_module, sym)); } INLINE void -set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) +set_symbol_plist (Lisp_Object sym, Lisp_Object plist) { - XSYMBOL (sym)->next = next; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + scm_variable_set_x (scm_module_lookup (plist_module, sym), plist); } /* Buffer-local (also frame-local) variable access functions. */ @@ -2899,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; @@ -2913,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; @@ -3362,6 +3301,7 @@ extern Lisp_Object Qlexical_binding; 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) @@ -3420,6 +3360,7 @@ extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); extern Lisp_Object eval_sub (Lisp_Object form); +extern Lisp_Object Ffuncall (ptrdiff_t nargs, Lisp_Object *args); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); extern Lisp_Object call0 (Lisp_Object); extern Lisp_Object call1 (Lisp_Object, Lisp_Object); @@ -3438,15 +3379,16 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern void specbind (Lisp_Object, Lisp_Object); +extern void record_unwind_protect_1 (void (*) (Lisp_Object), Lisp_Object, bool); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_ptr_1 (void (*) (void *), void *, bool); extern void record_unwind_protect_ptr (void (*) (void *), void *); +extern void record_unwind_protect_int_1 (void (*) (int), int, bool); extern void record_unwind_protect_int (void (*) (int), int); +extern void record_unwind_protect_void_1 (void (*) (void), bool); extern void record_unwind_protect_void (void (*) (void)); -extern void record_unwind_protect_nothing (void); -extern void clear_unwind_protect (ptrdiff_t); -extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); -extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); -extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); +extern void dynwind_begin (void); +extern void dynwind_end (void); extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern _Noreturn void verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); @@ -3466,6 +3408,9 @@ 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_global_binding_p (Lisp_Object symbol); +extern _Noreturn SCM abort_to_prompt (SCM, SCM); +extern SCM call_with_prompt (SCM, SCM, SCM); +extern SCM make_prompt_tag (void); /* Defined in editfns.c. */ @@ -3528,7 +3473,9 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int); extern void close_file_unwind (int); +extern void close_file_ptr_unwind (void *); extern void fclose_unwind (void *); +extern void fclose_ptr_unwind (void *); extern void restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); @@ -3966,16 +3913,13 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); - -#define USE_SAFE_ALLOCA \ - ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false +#define USE_SAFE_ALLOCA ((void) 0) /* SAFE_ALLOCA allocates a simple buffer. */ #define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \ ? alloca (size) \ - : (sa_must_free = true, record_xmalloc (size))) + : xmalloc (size)) /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER * NITEMS items, each of the same type as *BUF. MULTIPLIER must @@ -3986,23 +3930,12 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \ (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \ else \ - { \ - (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ - sa_must_free = true; \ - record_unwind_protect_ptr (xfree, buf); \ - } \ - } while (false) + (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ + } while (0) /* SAFE_FREE frees xmalloced memory and enables GC as needed. */ -#define SAFE_FREE() \ - do { \ - if (sa_must_free) { \ - sa_must_free = false; \ - unbind_to (sa_count, Qnil); \ - } \ - } while (false) - +#define SAFE_FREE() ((void) 0) /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */ @@ -4011,13 +3944,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); if ((nelt) < MAX_ALLOCA / word_size) \ (buf) = alloca ((nelt) * word_size); \ else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \ - { \ - Lisp_Object arg_; \ - (buf) = xmalloc ((nelt) * word_size); \ - arg_ = make_save_memory (buf, nelt); \ - sa_must_free = true; \ - record_unwind_protect (free_save_value, arg_); \ - } \ + buf = xmalloc ((nelt) * word_size); \ else \ memory_full (SIZE_MAX); \ } while (false) @@ -4071,8 +3998,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)) @@ -4080,10 +4007,7 @@ functionp (Lisp_Object object) Lisp_Object car = XCAR (object); return EQ (car, Qlambda) || EQ (car, Qclosure); } - else - return false; } INLINE_HEADER_END - #endif /* EMACS_LISP_H */