when_entered_debugger = -1;
}
+#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
+ || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
+void
+mark_catchlist (struct catchtag *catch)
+{
+ for (; catch; catch = catch->next)
+ {
+ mark_object (catch->tag);
+ mark_object (catch->val);
+ }
+}
+#endif
+
/* Unwind-protect function used by call_debugger. */
- static Lisp_Object
+ static void
restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
grow_specpdl ();
}
+ void
+ record_unwind_protect_ptr (void (*function) (void *), void *arg)
+ {
+ specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+ specpdl_ptr->unwind_ptr.func = function;
+ specpdl_ptr->unwind_ptr.arg = arg;
+ grow_specpdl ();
+ }
+
+ void
+ record_unwind_protect_int (void (*function) (int), int arg)
+ {
+ specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
+ specpdl_ptr->unwind_int.func = function;
+ specpdl_ptr->unwind_int.arg = arg;
+ grow_specpdl ();
+ }
+
+ void
+ record_unwind_protect_void (void (*function) (void))
+ {
+ specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
+ specpdl_ptr->unwind_void.func = function;
+ grow_specpdl ();
+ }
+
+void
+rebind_for_thread_switch (void)
+{
+ union specbinding *bind;
+
+ for (bind = specpdl; bind != specpdl_ptr; ++bind)
+ {
+ if (bind->kind >= SPECPDL_LET)
+ {
+ Lisp_Object value = specpdl_saved_value (bind);
+
+ bind->let.saved_value = Qnil;
+ do_specbind (XSYMBOL (binding_symbol (bind)), bind, value);
+ }
+ }
+}
+
static void
- specpdl_func (this_binding) (specpdl_arg (this_binding));
+do_one_unbind (union specbinding *this_binding, int unwinding)
+{
+ eassert (unwinding || this_binding->kind >= SPECPDL_LET);
+ switch (this_binding->kind)
+ {
+ case SPECPDL_UNWIND:
- case SPECPDL_BACKTRACE:
- break;
++ specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
++ break;
++ case SPECPDL_UNWIND_PTR:
++ specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
++ break;
++ case SPECPDL_UNWIND_INT:
++ specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
++ break;
++ case SPECPDL_UNWIND_VOID:
++ specpdl_ptr->unwind_void.func ();
++ break;
++ case SPECPDL_BACKTRACE:
+ break;
+ case SPECPDL_LET:
+ /* 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 (XSYMBOL (specpdl_symbol (this_binding))->redirect
+ == SYMBOL_PLAINVAL)
+ SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (this_binding)),
+ specpdl_old_value (this_binding));
+ else
+ /* NOTE: we only ever come here if make_local_foo was used for
+ the first time on this var within this let. */
+ Fset_default (specpdl_symbol (this_binding),
+ specpdl_old_value (this_binding));
+ break;
+ case SPECPDL_LET_LOCAL:
+ case SPECPDL_LET_DEFAULT:
+ { /* 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
+ bound a variable that had a buffer-local or frame-local
+ 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. */
+ Lisp_Object symbol = specpdl_symbol (this_binding);
+ Lisp_Object where = specpdl_where (this_binding);
+ eassert (BUFFERP (where));
+
+ if (this_binding->kind == SPECPDL_LET_DEFAULT)
+ Fset_default (symbol, specpdl_old_value (this_binding));
+ /* If this was a local binding, reset the value in the appropriate
+ buffer, but only if that buffer's binding still exists. */
+ else if (!NILP (Flocal_variable_p (symbol, where)))
+ set_internal (symbol, specpdl_old_value (this_binding),
+ where, 1);
+ }
+ break;
+ }
+}
+
++void
+ do_nothing (void)
+ {}
+
+ /* Push an unwind-protect entry that does nothing, so that
+ set_unwind_protect_ptr can overwrite it later. */
+
+ void
+ record_unwind_protect_nothing (void)
+ {
+ record_unwind_protect_void (do_nothing);
+ }
+
+ /* Clear the unwind-protect entry COUNT, so that it does nothing.
+ It need not be at the top of the stack. */
+
+ void
+ clear_unwind_protect (ptrdiff_t count)
+ {
+ union specbinding *p = specpdl + count;
+ p->unwind_void.kind = SPECPDL_UNWIND_VOID;
+ p->unwind_void.func = do_nothing;
+ }
+
+ /* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
+ It need not be at the top of the stack. Discard the entry's
+ previous value without invoking it. */
+
+ void
+ set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
+ {
+ union specbinding *p = specpdl + count;
+ p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+ p->unwind_ptr.func = func;
+ p->unwind_ptr.arg = arg;
+ }
+
+ /* Pop and execute entries from the unwind-protect stack until the
+ depth COUNT is reached. Return VALUE. */
+
Lisp_Object
unbind_to (ptrdiff_t count, Lisp_Object value)
{
}
}
+ /* For backtrace-eval, we want to temporarily unwind the last few elements of
+ the specpdl stack, and then rewind them. We store the pre-unwind values
+ directly in the pre-existing specpdl elements (i.e. we swap the current
+ value and the old value stored in the specpdl), kind of like the inplace
+ pointer-reversal trick. As it turns out, the rewind does the same as the
+ unwind, except it starts from the other end of the spepdl stack, so we use
+ the same function for both unwind and rewind. */
+ static void
+ backtrace_eval_unrewind (int distance)
+ {
+ union specbinding *tmp = specpdl_ptr;
+ int step = -1;
+ if (distance < 0)
+ { /* It's a rewind rather than unwind. */
+ tmp += distance - 1;
+ step = 1;
+ distance = -distance;
+ }
+
+ for (; distance > 0; distance--)
+ {
+ tmp += step;
+ /* */
+ switch (tmp->kind)
+ {
+ /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
+ unwind_protect, but the problem is that we don't know how to
+ rewind them afterwards. */
+ case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_PTR:
+ case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_VOID:
+ case SPECPDL_BACKTRACE:
+ break;
+ case SPECPDL_LET:
+ /* 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 (XSYMBOL (specpdl_symbol (tmp))->redirect
+ == SYMBOL_PLAINVAL)
+ {
+ struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp));
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
+ SET_SYMBOL_VAL (sym, old_value);
+ break;
+ }
+ else
+ {
+ /* FALLTHROUGH!
+ NOTE: we only ever come here if make_local_foo was used for
+ the first time on this var within this let. */
+ }
+ case SPECPDL_LET_DEFAULT:
+ {
+ Lisp_Object sym = specpdl_symbol (tmp);
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ set_specpdl_old_value (tmp, Fdefault_value (sym));
+ Fset_default (sym, old_value);
+ }
+ break;
+ case SPECPDL_LET_LOCAL:
+ {
+ Lisp_Object symbol = specpdl_symbol (tmp);
+ Lisp_Object where = specpdl_where (tmp);
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ eassert (BUFFERP (where));
+
+ /* If this was a local binding, reset the value in the appropriate
+ buffer, but only if that buffer's binding still exists. */
+ if (!NILP (Flocal_variable_p (symbol, where)))
+ {
+ set_specpdl_old_value
+ (tmp, Fbuffer_local_value (symbol, where));
+ set_internal (symbol, old_value, where, 1);
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
+ doc: /* Evaluate EXP in the context of some activation frame.
+ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
+ (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
+ {
+ union specbinding *pdl = get_backtrace_frame (nframes, base);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t distance = specpdl_ptr - pdl;
+ eassert (distance >= 0);
+
+ if (!backtrace_p (pdl))
+ error ("Activation frame not found!");
+
+ backtrace_eval_unrewind (distance);
+ record_unwind_protect_int (backtrace_eval_unrewind, -distance);
+
+ /* Use eval_sub rather than Feval since the main motivation behind
+ backtrace-eval is to be able to get/set the value of lexical variables
+ from the debugger. */
+ return unbind_to (count, eval_sub (exp));
+ }
\f
void
-mark_specpdl (void)
+mark_specpdl (union specbinding *first, union specbinding *ptr)
{
union specbinding *pdl;
- for (pdl = specpdl; pdl != specpdl_ptr; pdl++)
+ for (pdl = first; pdl != ptr; pdl++)
{
switch (pdl->kind)
{
(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 (Lisp_Object (*) (Lisp_Object), Lisp_Object);
+ extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
+ extern void record_unwind_protect_int (void (*) (int), int);
+ extern void record_unwind_protect_ptr (void (*) (void *), void *);
+ 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_ptr (ptrdiff_t, void (*) (void *), void *);
extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
+extern void rebind_for_thread_switch (void);
+extern void unbind_for_thread_switch (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);
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 mark_specpdl (union specbinding *first, union specbinding *ptr);
extern void get_backtrace (Lisp_Object array);
Lisp_Object backtrace_top_function (void);
extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
child_setup_tty (forkout);
#endif /* DONT_REOPEN_PTY */
#endif /* not USG, or USG_SUBTTY_WORKS */
- pty_flag = 1;
- }
- #endif /* HAVE_PTYS */
- fcntl (inchannel, F_SETFL, O_NONBLOCK);
- fcntl (outchannel, F_SETFL, O_NONBLOCK);
+ fcntl (inchannel, F_SETFL, O_NONBLOCK);
+ fcntl (outchannel, F_SETFL, O_NONBLOCK);
- /* Record this as an active process, with its channels.
- As a result, child_setup will close Emacs's side of the pipes. */
- chan_process[inchannel] = process;
- XPROCESS (process)->infd = inchannel;
- XPROCESS (process)->outfd = outchannel;
+ /* Record this as an active process, with its channels.
+ As a result, child_setup will close Emacs's side of the pipes. */
+ chan_process[inchannel] = process;
+ XPROCESS (process)->infd = inchannel;
+ XPROCESS (process)->outfd = outchannel;
- /* Previously we recorded the tty descriptor used in the subprocess.
- It was only used for getting the foreground tty process, so now
- we just reopen the device (see emacs_get_tty_pgrp) as this is
- more portable (see USG_SUBTTY_WORKS above). */
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
- XPROCESS (process)->pty_flag = pty_flag;
- pset_status (XPROCESS (process), Qrun);
- setup_process_coding_systems (process);
+ XPROCESS (process)->pty_flag = 1;
+ pset_status (XPROCESS (process), Qrun);
+ setup_process_coding_systems (process);
- add_process_read_fd (inchannel);
- FD_SET (inchannel, &input_wait_mask);
- FD_SET (inchannel, &non_keyboard_wait_mask);
- if (inchannel > max_process_desc)
- max_process_desc = inchannel;
-
+ pset_tty_name (XPROCESS (process), build_string (pty_name));
+ }
XPROCESS (process)->pid = -2;
- #ifdef HAVE_PTYS
- if (pty_flag)
- pset_tty_name (XPROCESS (process), build_string (pty_name));
- else
- #endif
- pset_tty_name (XPROCESS (process), Qnil);
}
\f
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (make_serial_process_unwind, proc);
+ record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
- fd = serial_open (SSDATA (port));
+ fd = serial_open (port);
p->infd = fd;
p->outfd = fd;
- if (fd > max_process_desc)
- max_process_desc = fd;
+ if (fd > max_desc)
+ max_desc = fd;
chan_process[fd] = proc;
buffer = Fplist_get (contact, QCbuffer);
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
- p->pty_flag = 0;
+ eassert (! p->pty_flag);
if (!EQ (p->command, Qt))
- {
- FD_SET (fd, &input_wait_mask);
- FD_SET (fd, &non_keyboard_wait_mask);
- }
+ add_non_keyboard_read_fd (fd);
if (BUFFERP (buffer))
{
build_string ("\n")));
}
- static Lisp_Object
- wait_reading_process_output_unwind (Lisp_Object data)
-/* This variable is different from waiting_for_input in keyboard.c.
- It is used to communicate to a lisp process-filter/sentinel (via the
- function Fwaiting_for_user_input_p below) whether Emacs was waiting
- for user-input when that process-filter was called.
- waiting_for_input cannot be used as that is by definition 0 when
- lisp code is being evalled.
- This is also used in record_asynch_buffer_change.
- For that purpose, this must be 0
- when not inside wait_reading_process_output. */
-static int waiting_for_user_input_p;
-
+ static void
+ wait_reading_process_output_unwind (int data)
{
- waiting_for_user_input_p = XINT (data);
- return Qnil;
+ clear_waiting_thread_info ();
+ waiting_for_user_input_p = data;
}
/* This is here so breakpoints can be put on it. */