Mercurial > hg > xemacs-beta
diff src/eval.c @ 5178:97eb4942aec8
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 29 Mar 2010 21:28:13 -0500 |
parents | 88bd4f3ef8e4 |
children | 1096ef427b56 |
line wrap: on
line diff
--- a/src/eval.c Tue Feb 23 07:28:35 2010 -0600 +++ b/src/eval.c Mon Mar 29 21:28:13 2010 -0500 @@ -418,6 +418,29 @@ static Lisp_Object maybe_get_trapping_problems_backtrace (void); + +/* When parsing keyword arguments; is some element of NARGS + :allow-other-keys, and is that element followed by a non-nil Lisp + object? */ + +Boolint +non_nil_allow_other_keys_p (Elemcount offset, int nargs, Lisp_Object *args) +{ + Lisp_Object key, value; + while (offset + 1 < nargs) + { + key = args[offset++]; + value = args[offset++]; + if (EQ (key, Q_allow_other_keys)) + { + /* The ANSI Common Lisp standard says the first value for a given + keyword overrides. */ + return !NILP (value); + } + } + return 0; +} + /************************************************************************/ /* The subr object type */ /************************************************************************/ @@ -432,7 +455,7 @@ const Ascbyte *trailer = subr->prompt ? " (interactive)>" : ">"; if (print_readably) - printing_unreadable_object ("%s%s%s", header, name, trailer); + printing_unreadable_object_fmt ("%s%s%s", header, name, trailer); write_ascstring (printcharfun, header); write_ascstring (printcharfun, name); @@ -444,11 +467,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr, - 1, /*dumpable-flag*/ - 0, print_subr, 0, 0, 0, - subr_description, - Lisp_Subr); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("subr", subr, + 0, print_subr, 0, 0, 0, + subr_description, + Lisp_Subr); /************************************************************************/ /* Entering the debugger */ @@ -3050,6 +3072,12 @@ } DOESNT_RETURN +invalid_keyword_argument (Lisp_Object function, Lisp_Object keyword) +{ + signal_error_1 (Qinvalid_keyword_argument, list2 (function, keyword)); +} + +DOESNT_RETURN invalid_constant (const Ascbyte *reason, Lisp_Object frob) { signal_error (Qinvalid_constant, reason, frob); @@ -4491,6 +4519,7 @@ Bytecount sizem; struct multiple_value *mv; Elemcount i, allocated_count; + Lisp_Object mvobj; assert (count != 1); @@ -4516,8 +4545,8 @@ sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (multiple_value, Lisp_Object, contents, allocated_count); - mv = (multiple_value *) BASIC_ALLOC_LCRECORD (sizem, - &lrecord_multiple_value); + mvobj = ALLOC_SIZED_LISP_OBJECT (sizem, multiple_value); + mv = XMULTIPLE_VALUE (mvobj); mv->count = count; mv->first_desired = first_desired; @@ -4529,7 +4558,7 @@ mv->contents[1 + (i - first_desired)] = Qunbound; } - return wrap_multiple_value (mv); + return mvobj; } void @@ -4576,13 +4605,13 @@ if (print_readably) { - printing_unreadable_object ("multiple values"); + printing_unreadable_object_fmt ("#<multiple values 0x%x>", + LISP_OBJECT_UID (obj)); } - if (0 == count) - { - write_msg_string (printcharfun, "#<zero-length multiple value>"); - } + write_fmt_string (printcharfun, + "#<INTERNAL OBJECT (XEmacs bug?) %d multiple values," + " data (", count); for (index = 0; index < count;) { @@ -4603,9 +4632,11 @@ if (count > 1 && index < count) { - write_ascstring (printcharfun, " ;\n"); + write_ascstring (printcharfun, " "); } } + + write_fmt_string (printcharfun, ") 0x%x>", LISP_OBJECT_UID (obj)); } static Lisp_Object @@ -4623,12 +4654,11 @@ } static Bytecount -size_multiple_value (const void *lheader) +size_multiple_value (Lisp_Object obj) { return FLEXIBLE_ARRAY_STRUCT_SIZEOF (struct multiple_value, Lisp_Object, contents, - ((struct multiple_value *) lheader)-> - allocated_count); + XMULTIPLE_VALUE (obj)->allocated_count); } static const struct memory_description multiple_value_description[] = { @@ -4640,15 +4670,14 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("multiple-value", multiple_value, - 1, /*dumpable-flag*/ - mark_multiple_value, - print_multiple_value, 0, - 0, /* No equal method. */ - 0, /* No hash method. */ - multiple_value_description, - size_multiple_value, - struct multiple_value); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("multiple-value", multiple_value, + mark_multiple_value, + print_multiple_value, 0, + 0, /* No equal method. */ + 0, /* No hash method. */ + multiple_value_description, + size_multiple_value, + struct multiple_value); /* Given that FIRST and UPPER are the inclusive lower and exclusive upper bounds for the multiple values we're interested in, modify (or don't) the @@ -7236,8 +7265,8 @@ void syms_of_eval (void) { - INIT_LRECORD_IMPLEMENTATION (subr); - INIT_LRECORD_IMPLEMENTATION (multiple_value); + INIT_LISP_OBJECT (subr); + INIT_LISP_OBJECT (multiple_value); DEFSYMBOL (Qinhibit_quit); DEFSYMBOL (Qautoload);