]> git.eshelyaron.com Git - emacs.git/commitdiff
merge from trunk
authorTom Tromey <tromey@redhat.com>
Fri, 26 Jul 2013 20:02:53 +0000 (14:02 -0600)
committerTom Tromey <tromey@redhat.com>
Fri, 26 Jul 2013 20:02:53 +0000 (14:02 -0600)
17 files changed:
1  2 
configure.ac
doc/lispref/Makefile.in
doc/lispref/elisp.texi
lisp/subr.el
src/Makefile.in
src/alloc.c
src/buffer.c
src/buffer.h
src/bytecode.c
src/data.c
src/emacs.c
src/eval.c
src/lisp.h
src/print.c
src/process.c
src/search.c
src/window.c

diff --cc configure.ac
Simple merge
Simple merge
Simple merge
diff --cc lisp/subr.el
Simple merge
diff --cc src/Makefile.in
Simple merge
diff --cc src/alloc.c
Simple merge
diff --cc src/buffer.c
Simple merge
diff --cc src/buffer.h
Simple merge
diff --cc src/bytecode.c
Simple merge
diff --cc src/data.c
Simple merge
diff --cc src/emacs.c
Simple merge
diff --cc src/eval.c
index 97e812dd890de3c2ebc43f9b47fc069e58ac1ee2,bb5d5efc9ba6f1c635aa96d054f75951acdc30ca..e93c3473ae80dc7c2f043b32893e1773667a9fcb
@@@ -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
-       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)
  {
@@@ -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));
+ }
  \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)
        {
diff --cc src/lisp.h
index acd21089655801c0839ae56745d39dfd9554157c,254ead231b9c7c932ecd2e900d39d47b651eaa7c..952991a32d9e9bd47b1b1c988e9b8e66efb7f65b
@@@ -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/print.c
Simple merge
diff --cc src/process.c
index dc37bfe706715f1563d1fe2391908eefdb66d199,d87a1803fe2a6f821d8e98668f3a921b475aaba1..33d8ccbbc356f1b667cb9323db7da003533cc511
@@@ -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);
  }
  
  \f
@@@ -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);
      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)
  {
-   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.  */
diff --cc src/search.c
Simple merge
diff --cc src/window.c
Simple merge