merge from trunk

1 files changed, 84 insertions, 140 deletions

diff --git a/src/data.c b/src/data.c
index a93cd169bf5..540c91bd4a5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -19,9 +19,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
-#include <signal.h>
 #include <stdio.h>
-#include <setjmp.h>
 
 #include <intprops.h>
 
@@ -36,19 +34,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "font.h"
 #include "keymap.h"
 
-#include <float.h>
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*.  */
-#ifndef IEEE_FLOATING_POINT
-#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
-     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-#define IEEE_FLOATING_POINT 1
-#else
-#define IEEE_FLOATING_POINT 0
-#endif
-#endif
-
-#include <math.h>
-
 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
 static Lisp_Object Qsubr;
 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
@@ -77,8 +62,8 @@ Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
 Lisp_Object Qcdr;
 static Lisp_Object Qad_advice_info, Qad_activate_internal;
 
-Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
-Lisp_Object Qoverflow_error, Qunderflow_error;
+static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
+Lisp_Object Qrange_error, Qoverflow_error;
 
 Lisp_Object Qfloatp;
 Lisp_Object Qnumberp, Qnumber_or_marker_p;
@@ -97,6 +82,7 @@ static Lisp_Object Qdefun;
 Lisp_Object Qthread, Qmutex, Qcondition_variable;
 
 Lisp_Object Qinteractive_form;
+static Lisp_Object Qdefalias_fset_function;
 
 static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
 
@@ -109,7 +95,7 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
      to try and do that by checking the tagbits, but nowadays all
      tagbits are potentially valid.  */
   /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
-   *   abort (); */
+   *   emacs_abort (); */
 
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
@@ -183,7 +169,7 @@ for example, (type-of 1) returns `integer'.  */)
         case Lisp_Misc_Float:
           return Qfloat;
         }
-      abort ();
+      emacs_abort ();
 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))
@@ -224,7 +210,7 @@ for example, (type-of 1) returns `integer'.  */)
       return Qfloat;
 
     default:
-      abort ();
+      emacs_abort ();
     }
 }
 
@@ -496,7 +482,7 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p,
     return Qnil;
 }
 
-/* Extract and set components of lists */
+/* Extract and set components of lists.  */
 
 DEFUN ("car", Fcar, Scar, 1, 1, 0,
        doc: /* Return the car of LIST.  If arg is nil, return nil.
@@ -557,7 +543,9 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
 /* Extract and set components of symbols.  */
 
 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
-       doc: /* Return t if SYMBOL's value is not void.  */)
+       doc: /* Return t if SYMBOL's value is not void.
+Note that if `lexical-binding' is in effect, this refers to the
+global value outside of any lexical scope.  */)
   (register Lisp_Object symbol)
 {
   Lisp_Object valcontents;
@@ -588,18 +576,19 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
       /* In set_internal, we un-forward vars when their value is
          set to Qunbound. */
       return Qt;
-    default: abort ();
+    default: emacs_abort ();
     }
 
   return (EQ (valcontents, Qunbound) ? Qnil : Qt);
 }
 
+/* FIXME: Make it an alias for function-symbol!  */
 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
        doc: /* Return t if SYMBOL's function definition is not void.  */)
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt;
+  return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 }
 
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -615,14 +604,14 @@ Return SYMBOL.  */)
 }
 
 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
-       doc: /* Make SYMBOL's function definition be void.
+       doc: /* Make SYMBOL's function definition be nil.
 Return SYMBOL.  */)
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
   if (NILP (symbol) || EQ (symbol, Qt))
     xsignal1 (Qsetting_constant, symbol);
-  set_symbol_function (symbol, Qunbound);
+  set_symbol_function (symbol, Qnil);
   return symbol;
 }
 
@@ -631,9 +620,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
     return XSYMBOL (symbol)->function;
-  xsignal1 (Qvoid_function, symbol);
 }
 
 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -660,27 +647,18 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
   (register Lisp_Object symbol, Lisp_Object definition)
 {
   register Lisp_Object function;
-
   CHECK_SYMBOL (symbol);
-  if (NILP (symbol) || EQ (symbol, Qt))
-    xsignal1 (Qsetting_constant, symbol);
 
   function = XSYMBOL (symbol)->function;
 
-  if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
+  if (!NILP (Vautoload_queue) && !NILP (function))
     Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
 
-  if (CONSP (function) && EQ (XCAR (function), Qautoload))
+  if (AUTOLOADP (function))
     Fput (symbol, Qautoload, XCDR (function));
 
   set_symbol_function (symbol, definition);
-  /* Handle automatic advice activation.  */
-  if (CONSP (XSYMBOL (symbol)->plist)
-      && !NILP (Fget (symbol, Qad_advice_info)))
-    {
-      call2 (Qad_activate_internal, symbol, Qnil);
-      definition = XSYMBOL (symbol)->function;
-    }
+
   return definition;
 }
 
@@ -694,15 +672,32 @@ The return value is undefined.  */)
   (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
 {
   CHECK_SYMBOL (symbol);
-  if (CONSP (XSYMBOL (symbol)->function)
-      && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
-    LOADHIST_ATTACH (Fcons (Qt, symbol));
   if (!NILP (Vpurify_flag)
       /* If `definition' is a keymap, immutable (and copying) is wrong.  */
       && !KEYMAPP (definition))
     definition = Fpurecopy (definition);
-  definition = Ffset (symbol, definition);
-  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+
+  {
+    bool autoload = AUTOLOADP (definition);
+    if (NILP (Vpurify_flag) || !autoload)
+      { /* Only add autoload entries after dumping, because the ones before are
+           not useful and else we get loads of them from the loaddefs.el.  */
+
+        if (AUTOLOADP (XSYMBOL (symbol)->function))
+          /* Remember that the function was already an autoload.  */
+          LOADHIST_ATTACH (Fcons (Qt, symbol));
+        LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
+      }
+  }
+
+  { /* Handle automatic advice activation.  */
+    Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
+    if (!NILP (hook))
+      call2 (hook, symbol, definition);
+    else
+      Ffset (symbol, definition);
+  }
+
   if (!NILP (docstring))
     Fput (symbol, Qfunction_documentation, docstring);
   /* We used to return `definition', but now that `defun' and `defmacro' expand
@@ -732,12 +727,10 @@ function with `&rest' args, or `unevalled' for a special form.  */)
   CHECK_SUBR (subr);
   minargs = XSUBR (subr)->min_args;
   maxargs = XSUBR (subr)->max_args;
-  if (maxargs == MANY)
-    return Fcons (make_number (minargs), Qmany);
-  else if (maxargs == UNEVALLED)
-    return Fcons (make_number (minargs), Qunevalled);
-  else
-    return Fcons (make_number (minargs), make_number (maxargs));
+  return Fcons (make_number (minargs),
+                maxargs == MANY ?        Qmany
+                : maxargs == UNEVALLED ? Qunevalled
+                :                        make_number (maxargs));
 }
 
 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -759,11 +752,11 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
 
-  if (NILP (fun) || EQ (fun, Qunbound))
+  if (NILP (fun))
     return Qnil;
 
   /* Use an `interactive-form' property if present, analogous to the
-     function-documentation property. */
+     function-documentation property.  */
   fun = cmd;
   while (SYMBOLP (fun))
     {
@@ -787,6 +780,8 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
         return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
     }
+  else if (AUTOLOADP (fun))
+    return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
@@ -794,14 +789,6 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
         return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
       else if (EQ (funcar, Qlambda))
         return Fassq (Qinteractive, Fcdr (XCDR (fun)));
-      else if (EQ (funcar, Qautoload))
-        {
-          struct gcpro gcpro1;
-          GCPRO1 (cmd);
-          Fautoload_do_load (fun, cmd, Qnil);
-          UNGCPRO;
-          return Finteractive_form (cmd);
-        }
     }
   return Qnil;
 }
@@ -901,7 +888,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
          don't think anything will break.  --lorentey  */
       return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
                               + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -987,12 +974,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
       break;
 
     default:
-      abort (); /* goto def; */
+      emacs_abort (); /* goto def; */
     }
 }
 
-/* Set up SYMBOL to refer to its global binding.
-   This makes it safe to alter the status of other bindings.  */
+/* Set up SYMBOL to refer to its global binding.  This makes it safe
+   to alter the status of other bindings.  BEWARE: this may be called
+   during the mark phase of GC, where we assume that Lisp_Object slots
+   of BLV are marked after this function has changed them.  */
 
 void
 swap_in_global_binding (struct Lisp_Symbol *symbol)
@@ -1051,7 +1040,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
         else
           {
             tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist));
-            XSETBUFFER (blv->where, current_buffer);
+            set_blv_where (blv, Fcurrent_buffer ());
           }
       }
       if (!(blv->found = !NILP (tem1)))
@@ -1092,12 +1081,14 @@ find_symbol_value (Lisp_Object symbol)
       /* FALLTHROUGH */
     case SYMBOL_FORWARDED:
       return do_symval_forwarding (SYMBOL_FWD (sym));
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
-       doc: /* Return SYMBOL's value.  Error if that is void.  */)
+       doc: /* Return SYMBOL's value.  Error if that is void.
+Note that if `lexical-binding' is in effect, this returns the
+global value outside of any lexical scope.  */)
   (Lisp_Object symbol)
 {
   Lisp_Object val;
@@ -1205,7 +1196,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
            the default binding is loaded, the loaded binding may be the
            wrong one.  */
         if (!EQ (blv->where, where)
-            /* Also unload a global binding (if the var is local_if_set). */
+            /* Also unload a global binding (if the var is local_if_set).  */
             || (EQ (blv->valcell, blv->defcell)))
           {
             /* The currently loaded binding is not necessarily valid.
@@ -1302,7 +1293,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
           store_symval_forwarding (/* sym, */ innercontents, newval, buf);
         break;
       }
-    default: abort ();
+    default: emacs_abort ();
     }
   return;
 }
@@ -1353,7 +1344,7 @@ default_value (Lisp_Object symbol)
         /* For other variables, get the current value.  */
         return do_symval_forwarding (valcontents);
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1451,7 +1442,7 @@ for this variable.  */)
         else
           return Fset (symbol, value);
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1575,7 +1566,7 @@ The function `default-value' gets the default value and `set-default' sets it.
       else if (BUFFER_OBJFWDP (valcontents.fwd))
         return variable;
       break;
-    default: abort ();
+    default: emacs_abort ();
     }
 
   if (sym->constant)
@@ -1648,7 +1639,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
         error ("Symbol %s may not be buffer-local",
                SDATA (SYMBOL_NAME (variable)));
       break;
-    default: abort ();
+    default: emacs_abort ();
     }
 
   if (sym->constant)
@@ -1755,7 +1746,7 @@ From now on the default value will apply in this buffer.  Return VARIABLE.  */)
       if (blv->frame_local)
         return variable;
       break;
-    default: abort ();
+    default: emacs_abort ();
     }
 
   /* Get rid of this buffer's alist element, if any.  */
@@ -1837,7 +1828,7 @@ frame-local bindings).  */)
         error ("Symbol %s may not be frame-local",
                SDATA (SYMBOL_NAME (variable)));
       break;
-    default: abort ();
+    default: emacs_abort ();
     }
 
   if (sym->constant)
@@ -1914,18 +1905,18 @@ BUFFER defaults to the current buffer.  */)
           }
         return Qnil;
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
        1, 2, 0,
-       doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
-More precisely, this means that setting the variable \(with `set' or`setq'),
-while it does not have a `let'-style binding that was made in BUFFER,
-will produce a buffer local binding.  See Info node
-`(elisp)Creating Buffer-Local'.
-BUFFER defaults to the current buffer.  */)
+       doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there.
+BUFFER defaults to the current buffer.
+
+More precisely, return non-nil if either VARIABLE already has a local
+value in BUFFER, or if VARIABLE is automatically buffer-local (see
+`make-variable-buffer-local').  */)
   (register Lisp_Object variable, Lisp_Object buffer)
 {
   struct Lisp_Symbol *sym;
@@ -1949,7 +1940,7 @@ BUFFER defaults to the current buffer.  */)
     case SYMBOL_FORWARDED:
       /* All BUFFER_OBJFWD slots become local if they are set.  */
       return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1993,7 +1984,7 @@ If the current binding is global (the default), the value is nil.  */)
         return SYMBOL_BLV (sym)->where;
       else
         return Qnil;
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -2057,10 +2048,10 @@ indirect_function (register Lisp_Object object)
 
   for (;;)
     {
-      if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+      if (!SYMBOLP (hare) || NILP (hare))
         break;
       hare = XSYMBOL (hare)->function;
-      if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+      if (!SYMBOLP (hare) || NILP (hare))
         break;
       hare = XSYMBOL (hare)->function;
 
@@ -2087,10 +2078,10 @@ function chain of symbols.  */)
 
   /* Optimize for no indirection.  */
   result = object;
-  if (SYMBOLP (result) && !EQ (result, Qunbound)
+  if (SYMBOLP (result) && !NILP (result)
       && (result = XSYMBOL (result)->function, SYMBOLP (result)))
     result = indirect_function (result);
-  if (!EQ (result, Qunbound))
+  if (!NILP (result))
     return result;
 
   if (NILP (noerror))
@@ -2309,7 +2300,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
       return Qnil;
 
     default:
-      abort ();
+      emacs_abort ();
     }
 }
 
@@ -2745,10 +2736,10 @@ usage: (* &rest NUMBERS-OR-MARKERS)  */)
   return arith_driver (Amult, nargs, args);
 }
 
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
        doc: /* Return first argument divided by all the remaining arguments.
 The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS)  */)
+usage: (/ DIVIDEND &rest DIVISORS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t argnum;
@@ -2775,28 +2766,6 @@ Both must be integers or markers.  */)
   return val;
 }
 
-#ifndef HAVE_FMOD
-double
-fmod (double f1, double f2)
-{
-  double r = f1;
-
-  if (f2 < 0.0)
-    f2 = -f2;
-
-  /* If the magnitude of the result exceeds that of the divisor, or
-     the sign of the result does not agree with that of the dividend,
-     iterate with the reduced value.  This does not yield a
-     particularly accurate result, but at least it will be in the
-     range promised by fmod.  */
-  do
-    r -= f2 * floor (r / f2);
-  while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
-
-  return r;
-}
-#endif /* ! HAVE_FMOD */
-
 DEFUN ("mod", Fmod, Smod, 2, 2, 0,
        doc: /* Return X modulo Y.
 The result falls between zero (inclusive) and Y (exclusive).
@@ -3138,6 +3107,7 @@ syms_of_data (void)
   DEFSYM (Qfont_object, "font-object");
 
   DEFSYM (Qinteractive_form, "interactive-form");
+  DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
 
   defsubr (&Sindirect_variable);
   defsubr (&Sinteractive_form);
@@ -3249,29 +3219,3 @@ syms_of_data (void)
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
   XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
 }
-
-#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
-_Noreturn
-#endif
-static void
-arith_error (int signo)
-{
-  sigsetmask (SIGEMPTYMASK);
-
-  SIGNAL_THREAD_CHECK (signo);
-  xsignal0 (Qarith_error);
-}
-
-void
-init_data (void)
-{
-  /* Don't do this if just dumping out.
-     We don't want to call `signal' in this case
-     so that we don't have trouble with dumping
-     signal-delivering routines in an inconsistent state.  */
-#ifndef CANNOT_DUMP
-  if (!initialized)
-    return;
-#endif /* CANNOT_DUMP */
-  signal (SIGFPE, arith_error);
-}