From: Tom Tromey Date: Fri, 26 Jul 2013 20:02:53 +0000 (-0600) Subject: merge from trunk X-Git-Tag: emacs-26.0.90~1144^2~17^2~23 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cc231cbe45d27a1906d268fb72d3b4105a2e9c65;p=emacs.git merge from trunk --- cc231cbe45d27a1906d268fb72d3b4105a2e9c65 diff --cc src/eval.c index 97e812dd890,bb5d5efc9ba..e93c3473ae8 --- a/src/eval.c +++ b/src/eval.c @@@ -272,22 -265,9 +272,22 @@@ init_eval (void 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)); @@@ -3264,73 -3210,72 +3275,148 @@@ record_unwind_protect (void (*function 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 +do_one_unbind (union specbinding *this_binding, int unwinding) +{ + eassert (unwinding || this_binding->kind >= SPECPDL_LET); + switch (this_binding->kind) + { + case SPECPDL_UNWIND: - specpdl_func (this_binding) (specpdl_arg (this_binding)); ++ 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_BACKTRACE: - 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) { @@@ -3483,12 -3476,115 +3587,115 @@@ nearest activation frame. */ } } + /* 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)); + } 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) { diff --cc src/lisp.h index acd21089655,254ead231b9..952991a32d9 --- a/src/lisp.h +++ b/src/lisp.h @@@ -3811,10 -3742,14 +3815,16 @@@ extern Lisp_Object internal_condition_c (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); @@@ -3826,9 -3761,10 +3836,10 @@@ extern Lisp_Object safe_call1 (Lisp_Obj 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); diff --cc src/process.c index dc37bfe7067,d87a1803fe2..33d8ccbbc35 --- a/src/process.c +++ b/src/process.c @@@ -2125,37 -1896,34 +2090,29 @@@ create_pty (Lisp_Object process 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); } @@@ -2763,14 -2525,14 +2714,14 @@@ usage: (make-serial-process &rest ARGS 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); @@@ -2789,10 -2551,13 +2740,10 @@@ 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)) { @@@ -4338,12 -4130,21 +4299,11 @@@ server_accept_connection (Lisp_Object s 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) { + clear_waiting_thread_info (); - waiting_for_user_input_p = XINT (data); - return Qnil; + waiting_for_user_input_p = data; } /* This is here so breakpoints can be put on it. */