#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
#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,
PVEC_HASH_TABLE,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
- PVEC_SUBR,
PVEC_OTHER,
/* These should be last, check internal_equal to see why. */
PVEC_COMPILED,
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);
else if (FLOATP (o))
return Lisp_Float;
else
- abort ();
+ return Lisp_Other;
}
/* Extract a value or address from a Lisp_Object. */
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. */
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)
{
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. */
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,
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;
/* 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 {
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. */
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. */
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
return PSEUDOVECTORP (a, PVEC_TERMINAL);
}
-INLINE bool
-SUBRP (Lisp_Object a)
-{
- return PSEUDOVECTORP (a, PVEC_SUBR);
-}
-
INLINE bool
COMPILEDP (Lisp_Object a)
{
/* 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. */
/* 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
{
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. */
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 {
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.
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. */
}
/* 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;
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;
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)
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);
(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);
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. */
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);
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
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. */
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)
}
}
- 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))
Lisp_Object car = XCAR (object);
return EQ (car, Qlambda) || EQ (car, Qclosure);
}
- else
- return false;
}
INLINE_HEADER_END
-
#endif /* EMACS_LISP_H */