/* Pointer to first unused element in specpdl. */
-struct specbinding *specpdl_ptr;
+volatile struct specbinding *specpdl_ptr;
/* Maximum size allowed for specpdl allocation */
int debug_while_redisplaying;
int count = SPECPDL_INDEX ();
Lisp_Object val;
-
+
if (lisp_eval_depth + 20 > max_lisp_eval_depth)
max_lisp_eval_depth = lisp_eval_depth + 20;
-
+
if (specpdl_size + 40 > max_specpdl_size)
max_specpdl_size = specpdl_size + 40;
-
+
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
redisplay, which necessarily leads to display problems. */
specbind (Qinhibit_eval_during_redisplay, Qt);
#endif
-
+
val = apply1 (Vdebugger, arg);
/* Interrupting redisplay and resuming it later is not safe under
(args)
Lisp_Object args;
{
- register Lisp_Object val;
- Lisp_Object args_left;
+ register Lisp_Object val = Qnil;
struct gcpro gcpro1;
- if (NILP(args))
- return Qnil;
-
- args_left = args;
- GCPRO1 (args_left);
+ GCPRO1 (args);
- do
+ while (CONSP (args))
{
- val = Feval (Fcar (args_left));
+ val = Feval (XCAR (args));
if (!NILP (val))
break;
- args_left = Fcdr (args_left);
+ args = XCDR (args);
}
- while (!NILP(args_left));
UNGCPRO;
return val;
(args)
Lisp_Object args;
{
- register Lisp_Object val;
- Lisp_Object args_left;
+ register Lisp_Object val = Qt;
struct gcpro gcpro1;
- if (NILP(args))
- return Qt;
-
- args_left = args;
- GCPRO1 (args_left);
+ GCPRO1 (args);
- do
+ while (CONSP (args))
{
- val = Feval (Fcar (args_left));
+ val = Feval (XCAR (args));
if (NILP (val))
break;
- args_left = Fcdr (args_left);
+ args = XCDR (args);
}
- while (!NILP(args_left));
UNGCPRO;
return val;
(args)
Lisp_Object args;
{
- register Lisp_Object val;
- Lisp_Object args_left;
+ register Lisp_Object val = Qnil;
struct gcpro gcpro1;
- if (NILP(args))
- return Qnil;
-
- args_left = args;
- GCPRO1 (args_left);
+ GCPRO1 (args);
- do
+ while (CONSP (args))
{
- val = Feval (Fcar (args_left));
- args_left = Fcdr (args_left);
+ val = Feval (XCAR (args));
+ args = XCDR (args);
}
- while (!NILP(args_left));
UNGCPRO;
return val;
UNGCPRO;
return val;
}
-
+
DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
usage: (quote ARG) */)
{
return Fcar (args);
}
-
+
DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
doc: /* Like `quote', but preferred for objects which are functions.
In byte compilation, `function' causes its argument to be compiled.
fun = Findirect_function (*btp->function);
if (exclude_subrs_p && SUBRP (fun))
return 0;
-
+
/* btp points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
(indent INDENT)
Set NAME's `lisp-indent-function' property to INDENT.
- (edebug DEBUG)
+ (debug DEBUG)
Set NAME's `edebug-form-spec' property to DEBUG. (This is
- equivalent to writing a `def-edebug-spec' for the macro.
+ equivalent to writing a `def-edebug-spec' for the macro.)
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
(args)
Lisp_Object args;
doc = Qnil;
if (STRINGP (Fcar (tail)))
{
- doc = Fcar (tail);
- tail = Fcdr (tail);
+ doc = XCAR (tail);
+ tail = XCDR (tail);
}
while (CONSP (Fcar (tail))
call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
UNGCPRO;
}
-
+
tail = Fcdr (tail);
}
else
tail = Fcons (lambda_list, Fcons (doc, tail));
defn = Fcons (Qmacro, Fcons (Qlambda, tail));
-
+
if (!NILP (Vpurify_flag))
defn = Fpurecopy (defn);
if (CONSP (XSYMBOL (fn_name)->function)
if (NILP (tem))
Fset_default (sym, Feval (Fcar (tail)));
tail = Fcdr (tail);
- if (!NILP (Fcar (tail)))
+ tem = Fcar (tail);
+ if (!NILP (tem))
{
- tem = Fcar (tail);
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
\(The alternative is a variable used internally in a Lisp program.)
Determined by whether the first character of the documentation
for the variable is `*' or if the variable is customizable (has a non-nil
-value of any of `custom-type', `custom-loads' or `standard-value'
-on its property list). */)
+value of `standard-value' or of `custom-autoload' on its property list). */)
(variable)
Lisp_Object variable;
{
Lisp_Object documentation;
-
+
if (!SYMBOLP (variable))
return Qnil;
&& INTEGERP (XCDR (documentation))
&& XINT (XCDR (documentation)) < 0)
return Qt;
- /* Customizable? */
- if ((!NILP (Fget (variable, intern ("custom-type"))))
- || (!NILP (Fget (variable, intern ("custom-loads"))))
- || (!NILP (Fget (variable, intern ("standard-value")))))
+ /* Customizable? See `custom-variable-p'. */
+ if ((!NILP (Fget (variable, intern ("standard-value"))))
+ || (!NILP (Fget (variable, intern ("custom-autoload")))))
return Qt;
return Qnil;
-}
+}
\f
DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
doc: /* Bind variables according to VARLIST then eval BODY.
#endif
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
-
+
_longjmp (catch->jmp, 1);
}
Lisp_Object val;
int count = SPECPDL_INDEX ();
- record_unwind_protect (0, Fcdr (args));
+ record_unwind_protect (Fprogn, Fcdr (args));
val = Feval (Fcar (args));
- return unbind_to (count, val);
+ return unbind_to (count, val);
}
\f
/* Chain of condition handlers currently in effect.
}
c.next = catchlist;
catchlist = &c;
-
+
h.var = var;
h.handler = handlers;
h.next = handlerlist;
struct backtrace *bp;
immediate_quit = handling_signal = 0;
+ abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
abort ();
if (display_hourglass_p)
cancel_hourglass ();
#endif
-#endif
+#endif
/* This hook is used by edebug. */
if (! NILP (Vsignal_hook_function)
for (; handlerlist; handlerlist = handlerlist->next)
{
register Lisp_Object clause;
-
+
if (lisp_eval_depth + 20 > max_lisp_eval_depth)
max_lisp_eval_depth = lisp_eval_depth + 20;
-
+
if (specpdl_size + 40 > max_specpdl_size)
max_specpdl_size = specpdl_size + 40;
-
+
clause = find_handler_clause (handlerlist->handler, conditions,
error_symbol, data, &debugger_value);
error_message = Ferror_message_string (data);
first_string = 0;
}
-
+
if (fast_string_match (XCAR (tail), error_message) >= 0)
return 1;
}
Vautoload_queue = oldqueue;
while (CONSP (queue))
{
- first = Fcar (queue);
+ first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
if (EQ (second, Qnil))
Vfeatures = first;
else
Ffset (first, second);
- queue = Fcdr (queue);
+ queue = XCDR (queue);
}
return Qnil;
}
/* Preserve the match data. */
record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
-
+
/* Value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
queue = Vautoload_queue;
while (CONSP (queue))
{
- first = Fcar (queue);
+ first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
may be an atom if the autoload entry was generated by a defalias
or fset. */
if (CONSP (second))
- Fput (first, Qautoload, (Fcdr (second)));
+ Fput (first, Qautoload, (XCDR (second)));
- queue = Fcdr (queue);
+ queue = XCDR (queue);
}
/* Once loading finishes, don't undo it. */
if (handling_signal)
abort ();
-
+
if (SYMBOLP (form))
return Fsymbol_value (form);
if (!CONSP (form))
#ifdef HAVE_CARBON
mac_check_for_quit_char();
-#endif
+#endif
return val;
}
\f
funcall_args = 0;
spread_arg = args [nargs - 1];
CHECK_LIST (spread_arg);
-
+
numargs = XINT (Flength (spread_arg));
if (numargs == 0)
spread_arg = XCDR (spread_arg);
}
+ /* By convention, the caller needs to gcpro Ffuncall's args. */
RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}
\f
return Qnil;
}
-
+
DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
- Lisp_Object args[2];
+ Lisp_Object args[2];
args[0] = fn;
args[1] = arg1;
default:
/* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
+ or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
abort ();
}
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
QUIT;
-
+
next = XCAR (syms_left);
while (!SYMBOLP (next))
next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
-
+
if (EQ (next, Qand_rest))
rest = 1;
else if (EQ (next, Qand_optional))
AREF (fun, COMPILED_CONSTANTS),
AREF (fun, COMPILED_STACK_DEPTH));
}
-
+
return unbind_to (count, val);
}
else
{
Lisp_Object valcontents;
-
+
ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
Lisp_Object where, current_buffer;
current_buffer = Fcurrent_buffer ();
-
+
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (symbol, Qnil)))
while (specpdl_ptr != specpdl + count)
{
- --specpdl_ptr;
-
- if (specpdl_ptr->func != 0)
- (*specpdl_ptr->func) (specpdl_ptr->old_value);
- /* Note that a "binding" of nil is really an unwind protect,
- so in that case the "old value" is a list of forms to evaluate. */
- else if (NILP (specpdl_ptr->symbol))
- Fprogn (specpdl_ptr->old_value);
+ /* Copy the binding, and decrement specpdl_ptr, before we do
+ the work to unbind it. We decrement first
+ so that an error in unbinding won't try to unbind
+ the same entry again, and we copy the binding first
+ in case more bindings are made during some of the code we run. */
+
+ struct specbinding this_binding;
+ this_binding = *--specpdl_ptr;
+
+ if (this_binding.func != 0)
+ (*this_binding.func) (this_binding.old_value);
/* If the symbol is a list, it is really (SYMBOL WHERE
. CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
frame. If WHERE is a buffer or frame, this indicates we
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
- else if (CONSP (specpdl_ptr->symbol))
+ else if (CONSP (this_binding.symbol))
{
Lisp_Object symbol, where;
- symbol = XCAR (specpdl_ptr->symbol);
- where = XCAR (XCDR (specpdl_ptr->symbol));
+ symbol = XCAR (this_binding.symbol);
+ where = XCAR (XCDR (this_binding.symbol));
if (NILP (where))
- Fset_default (symbol, specpdl_ptr->old_value);
+ Fset_default (symbol, this_binding.old_value);
else if (BUFFERP (where))
- set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);
- else
- set_internal (symbol, specpdl_ptr->old_value, NULL, 1);
+ set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
+ else
+ set_internal (symbol, this_binding.old_value, NULL, 1);
}
else
{
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
- if (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol)))
- SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value);
+ if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
+ SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
else
- set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
+ set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
}
}
-
+
if (NILP (Vquit_flag) && quitf)
Vquit_flag = Qt;
Qdeclare = intern ("declare");
staticpro (&Qdeclare);
-
+
/* Note that the process handling also uses Qexit, but we don't want
to staticpro it twice, so we just do it here. */
Qexit = intern ("exit");