Mercurial > emacs
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))