diff src/data.c @ 83532:b19aaf4ab0ee

Merged from emacs@sv.gnu.org. Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-331 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-332 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-333 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-334 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-335 Add note about "link" button-class to etc/TODO * emacs@sv.gnu.org/emacs--devo--0--patch-336 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-337 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-338 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-339 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-340 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-341 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-342 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-343 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-344 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-345 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-346 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-347 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-348 Update for ERC 5.1.3. * emacs@sv.gnu.org/emacs--devo--0--patch-349 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-350 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/gnus--rel--5.10--patch-111 Update from CVS: texi/gnus.texi (Summary Buffer Lines): Fix typo. * emacs@sv.gnu.org/gnus--rel--5.10--patch-112 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-113 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-114 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-572
author Karoly Lorentey <lorentey@elte.hu>
date Fri, 14 Jul 2006 05:56:32 +0000
parents 24cf4bf418dc dcd566ed4e9b
children 02e39decdc84
line wrap: on
line diff
--- a/src/data.c	Tue Jun 27 15:06:36 2006 +0000
+++ b/src/data.c	Fri Jul 14 05:56:32 2006 +0000
@@ -114,18 +114,13 @@
 wrong_type_argument (predicate, value)
      register Lisp_Object predicate, value;
 {
-  register Lisp_Object tem;
-  do
-    {
-      /* If VALUE is not even a valid Lisp object, abort here
-	 where we can get a backtrace showing where it came from.  */
-      if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
-	abort ();
-
-      value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
-      tem = call1 (predicate, value);
-    }
-  while (NILP (tem));
+  /* If VALUE is not even a valid Lisp object, abort here
+     where we can get a backtrace showing where it came from.  */
+  if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
+    abort ();
+
+  Fsignal (Qwrong_type_argument, list2 (predicate, value));
+
   /* This function is marked as NO_RETURN, gcc would warn if it has a
      return statement or if falls off the function.  Other compilers
      warn if no return statement is present.  */
@@ -395,8 +390,7 @@
      (object)
      Lisp_Object object;
 {
-  if (VECTORP (object) || STRINGP (object)
-      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
+  if (ARRAYP (object))
     return Qt;
   return Qnil;
 }
@@ -406,8 +400,7 @@
      (object)
      register Lisp_Object object;
 {
-  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
-      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
+  if (CONSP (object) || NILP (object) || ARRAYP (object))
     return Qt;
   return Qnil;
 }
@@ -537,15 +530,7 @@
      (list)
      register Lisp_Object list;
 {
-  while (1)
-    {
-      if (CONSP (list))
-	return XCAR (list);
-      else if (EQ (list, Qnil))
-	return Qnil;
-      else
-	list = wrong_type_argument (Qlistp, list);
-    }
+  return CAR (list);
 }
 
 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
@@ -553,10 +538,7 @@
      (object)
      Lisp_Object object;
 {
-  if (CONSP (object))
-    return XCAR (object);
-  else
-    return Qnil;
+  return CAR_SAFE (object);
 }
 
 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
@@ -568,15 +550,7 @@
      (list)
      register Lisp_Object list;
 {
-  while (1)
-    {
-      if (CONSP (list))
-	return XCDR (list);
-      else if (EQ (list, Qnil))
-	return Qnil;
-      else
-	list = wrong_type_argument (Qlistp, list);
-    }
+  return CDR (list);
 }
 
 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
@@ -584,10 +558,7 @@
      (object)
      Lisp_Object object;
 {
-  if (CONSP (object))
-    return XCDR (object);
-  else
-    return Qnil;
+  return CDR_SAFE (object);
 }
 
 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
@@ -595,9 +566,7 @@
      (cell, newcar)
      register Lisp_Object cell, newcar;
 {
-  if (!CONSP (cell))
-    cell = wrong_type_argument (Qconsp, cell);
-
+  CHECK_CONS (cell);
   CHECK_IMPURE (cell);
   XSETCAR (cell, newcar);
   return newcar;
@@ -608,9 +577,7 @@
      (cell, newcdr)
      register Lisp_Object cell, newcdr;
 {
-  if (!CONSP (cell))
-    cell = wrong_type_argument (Qconsp, cell);
-
+  CHECK_CONS (cell);
   CHECK_IMPURE (cell);
   XSETCDR (cell, newcdr);
   return newcdr;
@@ -765,8 +732,7 @@
      Lisp_Object subr;
 {
   short minargs, maxargs;
-  if (!SUBRP (subr))
-    wrong_type_argument (Qsubrp, subr);
+  CHECK_SUBR (subr);
   minargs = XSUBR (subr)->min_args;
   maxargs = XSUBR (subr)->max_args;
   if (maxargs == MANY)
@@ -784,8 +750,7 @@
      Lisp_Object subr;
 {
   const char *name;
-  if (!SUBRP (subr))
-    wrong_type_argument (Qsubrp, subr);
+  CHECK_SUBR (subr);
   name = XSUBR (subr)->symbol_name;
   return make_string (name, strlen (name));
 }
@@ -2005,13 +1970,18 @@
 {
   Lisp_Object result;
 
-  result = indirect_function (object);
-
-  if (EQ (result, Qunbound))
-    return (NILP (noerror)
-	    ? Fsignal (Qvoid_function, Fcons (object, Qnil))
-	    : Qnil);
-  return result;
+  /* Optimize for no indirection.  */
+  result = object;
+  if (SYMBOLP (result) && !EQ (result, Qunbound)
+      && (result = XSYMBOL (result)->function, SYMBOLP (result)))
+    result = indirect_function (result);
+  if (!EQ (result, Qunbound))
+    return result;
+
+  if (NILP (noerror))
+    Fsignal (Qvoid_function, Fcons (object, Qnil));
+
+  return Qnil;
 }
 
 /* Extract and set vector and string elements */
@@ -2173,9 +2143,7 @@
 
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
-  if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
-      && ! CHAR_TABLE_P (array))
-    array = wrong_type_argument (Qarrayp, array);
+  CHECK_ARRAY (array, Qarrayp);
   CHECK_IMPURE (array);
 
   if (VECTORP (array))