]> code.delx.au - gnu-emacs/blobdiff - src/data.c
Fix Imenu regression.
[gnu-emacs] / src / data.c
index 6cd3649d45f3b3554b83f016a2196463c2c16107..abcdd4dca0d0953918e8dbfacc0ca2e03fe1b758 100644 (file)
@@ -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,14 +62,14 @@ 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;
 
-Lisp_Object Qinteger, Qinterval, Qfloat, Qvector;
-Lisp_Object Qsymbol, Qstring, Qcons, Qmisc;
+Lisp_Object Qinteger, Qsymbol;
+static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
 Lisp_Object Qwindow;
 static Lisp_Object Qoverlay, Qwindow_configuration;
 static Lisp_Object Qprocess, Qmarker;
@@ -108,7 +93,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);
 }
@@ -182,7 +167,7 @@ for example, (type-of 1) returns `integer'.  */)
        case Lisp_Misc_Float:
          return Qfloat;
        }
-      abort ();
+      emacs_abort ();
 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))
@@ -217,7 +202,7 @@ for example, (type-of 1) returns `integer'.  */)
       return Qfloat;
 
     default:
-      abort ();
+      emacs_abort ();
     }
 }
 
@@ -551,7 +536,7 @@ 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);
@@ -847,7 +832,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
       return *XOBJFWD (valcontents)->objvar;
 
     case Lisp_Fwd_Buffer_Obj:
-      return PER_BUFFER_VALUE (current_buffer,
+      return per_buffer_value (current_buffer,
                               XBUFFER_OBJFWD (valcontents)->offset);
 
     case Lisp_Fwd_Kboard_Obj:
@@ -864,7 +849,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 ();
     }
 }
 
@@ -919,7 +904,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
              b = XBUFFER (lbuf);
 
              if (! PER_BUFFER_VALUE_P (b, idx))
-               PER_BUFFER_VALUE (b, offset) = newval;
+               set_per_buffer_value (b, offset, newval);
            }
        }
       break;
@@ -937,7 +922,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
 
        if (buf == NULL)
          buf = current_buffer;
-       PER_BUFFER_VALUE (buf, offset) = newval;
+       set_per_buffer_value (buf, offset, newval);
       }
       break;
 
@@ -950,12 +935,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)
@@ -1014,7 +1001,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)))
@@ -1055,7 +1042,7 @@ find_symbol_value (Lisp_Object symbol)
       /* FALLTHROUGH */
     case SYMBOL_FORWARDED:
       return do_symval_forwarding (SYMBOL_FWD (sym));
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1080,10 +1067,10 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
   return newval;
 }
 
-/* Return 1 if SYMBOL currently has a let-binding
+/* Return true if SYMBOL currently has a let-binding
    which was made in the buffer that is now current.  */
 
-static int
+static bool
 let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
 {
   struct specbinding *p;
@@ -1102,7 +1089,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
   return 0;
 }
 
-static int
+static bool
 let_shadows_global_binding_p (Lisp_Object symbol)
 {
   struct specbinding *p;
@@ -1118,14 +1105,15 @@ let_shadows_global_binding_p (Lisp_Object symbol)
    If buffer/frame-locality is an issue, WHERE specifies which context to use.
    (nil stands for the current buffer/frame).
 
-   If BINDFLAG is zero, then if this symbol is supposed to become
+   If BINDFLAG is false, then if this symbol is supposed to become
    local in every buffer where it is set, then we make it local.
-   If BINDFLAG is nonzero, we don't do that.  */
+   If BINDFLAG is true, we don't do that.  */
 
 void
-set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag)
+set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+             bool bindflag)
 {
-  int voide = EQ (newval, Qunbound);
+  bool voide = EQ (newval, Qunbound);
   struct Lisp_Symbol *sym;
   Lisp_Object tem1;
 
@@ -1167,7 +1155,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
           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.
@@ -1184,7 +1172,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
                           ? XFRAME (where)->param_alist
                           : BVAR (XBUFFER (where), local_var_alist)));
            set_blv_where (blv, where);
-           set_blv_found (blv, 1);
+           blv->found = 1;
 
            if (NILP (tem1))
              {
@@ -1199,7 +1187,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
                if (bindflag || !blv->local_if_set
                    || let_shadows_buffer_binding_p (sym))
                  {
-                   set_blv_found (blv, 0);
+                   blv->found = 0;
                    tem1 = blv->defcell;
                  }
                /* If it's a local_if_set, being set not bound,
@@ -1213,8 +1201,9 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
                       bindings, not for frame-local bindings.  */
                    eassert (!blv->frame_local);
                    tem1 = Fcons (symbol, XCDR (blv->defcell));
-                   BSET (XBUFFER (where), local_var_alist,
-                         Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
+                   bset_local_var_alist
+                     (XBUFFER (where),
+                      Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
                  }
              }
 
@@ -1263,7 +1252,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
          store_symval_forwarding (/* sym, */ innercontents, newval, buf);
        break;
       }
-    default: abort ();
+    default: emacs_abort ();
     }
   return;
 }
@@ -1308,13 +1297,13 @@ default_value (Lisp_Object symbol)
          {
            int offset = XBUFFER_OBJFWD (valcontents)->offset;
            if (PER_BUFFER_IDX (offset) != 0)
-             return PER_BUFFER_DEFAULT (offset);
+             return per_buffer_default (offset);
          }
 
        /* For other variables, get the current value.  */
        return do_symval_forwarding (valcontents);
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1395,7 +1384,7 @@ for this variable.  */)
            int offset = XBUFFER_OBJFWD (valcontents)->offset;
            int idx = PER_BUFFER_IDX (offset);
 
-           PER_BUFFER_DEFAULT (offset) = value;
+           set_per_buffer_default (offset, value);
 
            /* If this variable is not always local in all buffers,
               set it in the buffers that don't nominally have a local value.  */
@@ -1405,14 +1394,14 @@ for this variable.  */)
 
                FOR_EACH_BUFFER (b)
                  if (!PER_BUFFER_VALUE_P (b, idx))
-                   PER_BUFFER_VALUE (b, offset) = value;
+                   set_per_buffer_value (b, offset, value);
              }
            return value;
          }
        else
          return Fset (symbol, value);
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -1463,7 +1452,8 @@ union Lisp_Val_Fwd
   };
 
 static struct Lisp_Buffer_Local_Value *
-make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents)
+make_blv (struct Lisp_Symbol *sym, bool forwarded,
+         union Lisp_Val_Fwd valcontents)
 {
   struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
   Lisp_Object symbol;
@@ -1507,7 +1497,7 @@ The function `default-value' gets the default value and `set-default' sets it.
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
   union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
-  int forwarded IF_LINT (= 0);
+  bool forwarded IF_LINT (= 0);
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
@@ -1535,7 +1525,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)
@@ -1579,10 +1569,10 @@ See also `make-variable-buffer-local'.
 
 Do not use `make-local-variable' to make a hook variable buffer-local.
 Instead, use `add-hook' and specify t for the LOCAL argument.  */)
-  (register Lisp_Object variable)
+  (Lisp_Object variable)
 {
-  register Lisp_Object tem;
-  int forwarded IF_LINT (= 0);
+  Lisp_Object tem;
+  bool forwarded IF_LINT (= 0);
   union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1608,7 +1598,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)
@@ -1653,9 +1643,10 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
         default value.  */
       find_symbol_value (variable);
 
-      BSET (current_buffer, local_var_alist,
-           Fcons (Fcons (variable, XCDR (blv->defcell)),
-                  BVAR (current_buffer, local_var_alist)));
+      bset_local_var_alist
+       (current_buffer,
+        Fcons (Fcons (variable, XCDR (blv->defcell)),
+               BVAR (current_buffer, local_var_alist)));
 
       /* Make sure symbol does not think it is set up for this buffer;
         force it to look once again for this buffer's value.  */
@@ -1703,8 +1694,8 @@ From now on the default value will apply in this buffer.  Return VARIABLE.  */)
            if (idx > 0)
              {
                SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
-               PER_BUFFER_VALUE (current_buffer, offset)
-                 = PER_BUFFER_DEFAULT (offset);
+               set_per_buffer_value (current_buffer, offset,
+                                     per_buffer_default (offset));
              }
          }
        return variable;
@@ -1714,15 +1705,16 @@ 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.  */
   XSETSYMBOL (variable, sym);  /* Propagate variable indirection.  */
   tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
   if (!NILP (tem))
-    BSET (current_buffer, local_var_alist,
-         Fdelq (tem, BVAR (current_buffer, local_var_alist)));
+    bset_local_var_alist
+      (current_buffer,
+       Fdelq (tem, BVAR (current_buffer, local_var_alist)));
 
   /* If the symbol is set up with the current buffer's binding
      loaded, recompute its value.  We have to do it now, or else
@@ -1732,7 +1724,7 @@ From now on the default value will apply in this buffer.  Return VARIABLE.  */)
     if (EQ (buf, blv->where))
       {
        set_blv_where (blv, Qnil);
-       set_blv_found (blv, 0);
+       blv->found = 0;
        find_symbol_value (variable);
       }
   }
@@ -1764,9 +1756,9 @@ is to set the VARIABLE frame parameter of that frame.  See
 Note that since Emacs 23.1, variables cannot be both buffer-local and
 frame-local any more (buffer-local bindings used to take precedence over
 frame-local bindings).  */)
-  (register Lisp_Object variable)
+  (Lisp_Object variable)
 {
-  int forwarded;
+  bool forwarded;
   union Lisp_Val_Fwd valcontents;
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1795,7 +1787,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)
@@ -1872,18 +1864,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;
@@ -1907,7 +1899,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 ();
     }
 }
 
@@ -1951,7 +1943,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 ();
     }
 }
 
@@ -2222,7 +2214,7 @@ static Lisp_Object
 arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
 {
   double f1 = 0, f2 = 0;
-  int floatp = 0;
+  bool floatp = 0;
 
   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
@@ -2267,7 +2259,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
       return Qnil;
 
     default:
-      abort ();
+      emacs_abort ();
     }
 }
 
@@ -2339,7 +2331,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
 uintmax_t
 cons_to_unsigned (Lisp_Object c, uintmax_t max)
 {
-  int valid = 0;
+  bool valid = 0;
   uintmax_t val IF_LINT (= 0);
   if (INTEGERP (c))
     {
@@ -2392,7 +2384,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
 intmax_t
 cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
 {
-  int valid = 0;
+  bool valid = 0;
   intmax_t val IF_LINT (= 0);
   if (INTEGERP (c))
     {
@@ -2510,14 +2502,11 @@ static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
 static Lisp_Object
 arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
 {
-  register Lisp_Object val;
-  ptrdiff_t argnum;
-  register EMACS_INT accum = 0;
-  register EMACS_INT next;
-
-  int overflow = 0;
-  ptrdiff_t ok_args;
-  EMACS_INT ok_accum;
+  Lisp_Object val;
+  ptrdiff_t argnum, ok_args;
+  EMACS_INT accum = 0;
+  EMACS_INT next, ok_accum;
+  bool overflow = 0;
 
   switch (code)
     {
@@ -2736,28 +2725,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).
@@ -3087,8 +3054,6 @@ syms_of_data (void)
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");
-  /* Used by Fgarbage_collect.  */
-  DEFSYM (Qinterval, "interval");
   DEFSYM (Qmisc, "misc");
 
   DEFSYM (Qdefun, "defun");
@@ -3206,29 +3171,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);
-}