Don't let the 'B' interactive spec default to buffers viewed in

[bpt/emacs.git] / src / data.c

diff --git a/src/data.c b/src/data.c
index 66b4e90..1121cb3 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -31,6 +31,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "syssignal.h"
 
 #ifdef LISP_FLOAT_TYPE
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
 #include <math.h>
 #endif /* LISP_FLOAT_TYPE */
 
@@ -518,10 +521,43 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
      register Lisp_Object sym, newdef;
 {
   CHECK_SYMBOL (sym, 0);
+
+  if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
+    Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
+                            Vautoload_queue);
+  XSYMBOL (sym)->function = newdef;
+  return newdef;
+}
+
+/* This name should be removed once it is eliminated from elsewhere.  */
+
+DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,
+  "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
+Associates the function with the current load file, if any.")
+  (sym, newdef)
+     register Lisp_Object sym, newdef;
+{
+  CHECK_SYMBOL (sym, 0);
+  if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
+    Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
+                            Vautoload_queue);
+  XSYMBOL (sym)->function = newdef;
+  LOADHIST_ATTACH (sym);
+  return newdef;
+}
+
+DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0,
+  "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
+Associates the function with the current load file, if any.")
+  (sym, newdef)
+     register Lisp_Object sym, newdef;
+{
+  CHECK_SYMBOL (sym, 0);
   if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
     Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
                             Vautoload_queue);
   XSYMBOL (sym)->function = newdef;
+  LOADHIST_ATTACH (sym);
   return newdef;
 }
 
@@ -1179,9 +1215,9 @@ Lisp_Object
 indirect_function (object)
   register Lisp_Object object;
 {
-  Lisp_Object tortise, hare;
+  Lisp_Object tortoise, hare;
 
-  hare = tortise = object;
+  hare = tortoise = object;
 
   for (;;)
     {
@@ -1192,9 +1228,9 @@ indirect_function (object)
        break;
       hare = XSYMBOL (hare)->function;
 
-      tortise = XSYMBOL (tortise)->function;
+      tortoise = XSYMBOL (tortoise)->function;
 
-      if (EQ (hare, tortise))
+      if (EQ (hare, tortoise))
        Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
     }
 
@@ -1444,7 +1480,7 @@ unsigned long
 cons_to_long (c)
      Lisp_Object c;
 {
-  int top, bot;
+  Lisp_Object top, bot;
   if (INTEGERP (c))
     return XINT (c);
   top = XCONS (c)->car;
@@ -1512,8 +1548,7 @@ enum arithop
 extern Lisp_Object float_arith_driver ();
 
 Lisp_Object
-arith_driver
-  (code, nargs, args)
+arith_driver (code, nargs, args)
      enum arithop code;
      int nargs;
      register Lisp_Object *args;
@@ -1569,7 +1604,12 @@ arith_driver
        case Amult: accum *= next; break;
        case Adiv:
          if (!argnum) accum = next;
-         else accum /= next;
+         else
+           {
+             if (next == 0)
+               Fsignal (Qarith_error, Qnil);
+             accum /= next;
+           }
          break;
        case Alogand: accum &= next; break;
        case Alogior: accum |= next; break;
@@ -1630,7 +1670,11 @@ float_arith_driver (accum, argnum, code, nargs, args)
          if (!argnum)
            accum = next;
          else
-           accum /= next;
+           {
+             if (next == 0)
+               Fsignal (Qarith_error, Qnil);
+             accum /= next;
+           }
          break;
        case Alogand:
        case Alogior:
@@ -1708,12 +1752,16 @@ Both must be numbers or markers.")
 
       f1 = XTYPE (num1) == Lisp_Float ? XFLOAT (num1)->data : XINT (num1);
       f2 = XTYPE (num2) == Lisp_Float ? XFLOAT (num2)->data : XINT (num2);
+      if (f2 == 0)
+       Fsignal (Qarith_error, Qnil);
+
 #if defined (USG) || defined (sun) || defined (ultrix) || defined (hpux)
       f1 = fmod (f1, f2);
 #else
       f1 = drem (f1, f2);
 #endif
-      if (f1 < 0)
+      /* If the "remainder" comes out with the wrong sign, fix it.  */
+      if ((f1 < 0) != (f2 < 0))
        f1 += f2;
       return (make_float (f1));
     }
@@ -1722,6 +1770,9 @@ Both must be numbers or markers.")
   CHECK_NUMBER_COERCE_MARKER (num2, 1);
 #endif /* not LISP_FLOAT_TYPE */
 
+  if (XFASTINT (num2) == 0)
+    Fsignal (Qarith_error, Qnil);
+
   XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
   return val;
 }
@@ -2138,6 +2189,8 @@ syms_of_data ()
   defsubr (&Sboundp);
   defsubr (&Sfboundp);
   defsubr (&Sfset);
+  defsubr (&Sdefalias);
+  defsubr (&Sdefine_function);
   defsubr (&Ssetplist);
   defsubr (&Ssymbol_value);
   defsubr (&Sset);