X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a6981b1188520ef2236e8f59abadf7c0f333bba0..534c20b22f89ffbe99a4d6a1035b74eacc544ee5:/src/data.c diff --git a/src/data.c b/src/data.c index aabed27f20..4aea53cc02 100644 --- a/src/data.c +++ b/src/data.c @@ -1,5 +1,6 @@ /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. - Copyright (C) 1985,86,88,93,94,95,97,98,99,2000 Free Software Foundation, Inc. + Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -64,6 +65,7 @@ Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection; +Lisp_Object Qcyclic_variable_indirection, Qcircular_list; Lisp_Object Qsetting_constant, Qinvalid_read_syntax; Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; @@ -92,9 +94,18 @@ static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; -static Lisp_Object swap_in_symval_forwarding (); +static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); + +Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum; + + +void +circular_list_error (list) + Lisp_Object list; +{ + Fsignal (Qcircular_list, list); +} -Lisp_Object set_internal (); Lisp_Object wrong_type_argument (predicate, value) @@ -103,15 +114,6 @@ wrong_type_argument (predicate, value) register Lisp_Object tem; do { - if (!EQ (Vmocklisp_arguments, Qt)) - { - if (STRINGP (value) && - (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p))) - return Fstring_to_number (value, Qnil); - if (INTEGERP (value) && EQ (predicate, Qstringp)) - return Fnumber_to_string (value); - } - /* 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) @@ -166,8 +168,8 @@ sign_extend_lisp_int (num) /* Data type predicates */ DEFUN ("eq", Feq, Seq, 2, 2, 0, - "Return t if the two args are the same Lisp object.") - (obj1, obj2) + doc: /* Return t if the two args are the same Lisp object. */) + (obj1, obj2) Lisp_Object obj1, obj2; { if (EQ (obj1, obj2)) @@ -175,8 +177,9 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0, return Qnil; } -DEFUN ("null", Fnull, Snull, 1, 1, 0, "Return t if OBJECT is nil.") - (object) +DEFUN ("null", Fnull, Snull, 1, 1, 0, + doc: /* Return t if OBJECT is nil. */) + (object) Lisp_Object object; { if (NILP (object)) @@ -185,10 +188,10 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0, "Return t if OBJECT is nil.") } DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, - "Return a symbol representing the type of OBJECT.\n\ -The symbol returned names the object's basic type;\n\ -for example, (type-of 1) returns `integer'.") - (object) + doc: /* Return a symbol representing the type of OBJECT. +The symbol returned names the object's basic type; +for example, (type-of 1) returns `integer'. */) + (object) Lisp_Object object; { switch (XGCTYPE (object)) @@ -248,8 +251,9 @@ for example, (type-of 1) returns `integer'.") } } -DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "Return t if OBJECT is a cons cell.") - (object) +DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, + doc: /* Return t if OBJECT is a cons cell. */) + (object) Lisp_Object object; { if (CONSP (object)) @@ -258,8 +262,8 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "Return t if OBJECT is a cons cell.") } DEFUN ("atom", Fatom, Satom, 1, 1, 0, - "Return t if OBJECT is not a cons cell. This includes nil.") - (object) + doc: /* Return t if OBJECT is not a cons cell. This includes nil. */) + (object) Lisp_Object object; { if (CONSP (object)) @@ -268,8 +272,8 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0, } DEFUN ("listp", Flistp, Slistp, 1, 1, 0, - "Return t if OBJECT is a list. This includes nil.") - (object) + doc: /* Return t if OBJECT is a list. This includes nil. */) + (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) @@ -278,8 +282,8 @@ DEFUN ("listp", Flistp, Slistp, 1, 1, 0, } DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, - "Return t if OBJECT is not a list. Lists include nil.") - (object) + doc: /* Return t if OBJECT is not a list. Lists include nil. */) + (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) @@ -288,8 +292,8 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, } DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, - "Return t if OBJECT is a symbol.") - (object) + doc: /* Return t if OBJECT is a symbol. */) + (object) Lisp_Object object; { if (SYMBOLP (object)) @@ -300,22 +304,22 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, /* Define this in C to avoid unnecessarily consing up the symbol name. */ DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0, - "Return t if OBJECT is a keyword.\n\ -This means that it is a symbol with a print name beginning with `:'\n\ -interned in the initial obarray.") - (object) + doc: /* Return t if OBJECT is a keyword. +This means that it is a symbol with a print name beginning with `:' +interned in the initial obarray. */) + (object) Lisp_Object object; { if (SYMBOLP (object) && XSYMBOL (object)->name->data[0] == ':' - && EQ (XSYMBOL (object)->obarray, initial_obarray)) + && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object)) return Qt; return Qnil; } DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, - "Return t if OBJECT is a vector.") - (object) + doc: /* Return t if OBJECT is a vector. */) + (object) Lisp_Object object; { if (VECTORP (object)) @@ -324,8 +328,8 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, } DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, - "Return t if OBJECT is a string.") - (object) + doc: /* Return t if OBJECT is a string. */) + (object) Lisp_Object object; { if (STRINGP (object)) @@ -334,8 +338,9 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, } DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p, - 1, 1, 0, "Return t if OBJECT is a multibyte string.") - (object) + 1, 1, 0, + doc: /* Return t if OBJECT is a multibyte string. */) + (object) Lisp_Object object; { if (STRINGP (object) && STRING_MULTIBYTE (object)) @@ -344,8 +349,8 @@ DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p, } DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, - "Return t if OBJECT is a char-table.") - (object) + doc: /* Return t if OBJECT is a char-table. */) + (object) Lisp_Object object; { if (CHAR_TABLE_P (object)) @@ -355,8 +360,8 @@ DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p, Svector_or_char_table_p, 1, 1, 0, - "Return t if OBJECT is a char-table or vector.") - (object) + doc: /* Return t if OBJECT is a char-table or vector. */) + (object) Lisp_Object object; { if (VECTORP (object) || CHAR_TABLE_P (object)) @@ -364,8 +369,9 @@ DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p, return Qnil; } -DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "Return t if OBJECT is a bool-vector.") - (object) +DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, + doc: /* Return t if OBJECT is a bool-vector. */) + (object) Lisp_Object object; { if (BOOL_VECTOR_P (object)) @@ -373,8 +379,9 @@ DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "Return t if OB return Qnil; } -DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "Return t if OBJECT is an array (string or vector).") - (object) +DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, + doc: /* Return t if OBJECT is an array (string or vector). */) + (object) Lisp_Object object; { if (VECTORP (object) || STRINGP (object) @@ -384,8 +391,8 @@ DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "Return t if OBJECT is an array (str } DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, - "Return t if OBJECT is a sequence (list or array).") - (object) + doc: /* Return t if OBJECT is a sequence (list or array). */) + (object) register Lisp_Object object; { if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) @@ -394,8 +401,9 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, return Qnil; } -DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "Return t if OBJECT is an editor buffer.") - (object) +DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, + doc: /* Return t if OBJECT is an editor buffer. */) + (object) Lisp_Object object; { if (BUFFERP (object)) @@ -403,8 +411,9 @@ DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "Return t if OBJECT is an editor return Qnil; } -DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "Return t if OBJECT is a marker (editor pointer).") - (object) +DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, + doc: /* Return t if OBJECT is a marker (editor pointer). */) + (object) Lisp_Object object; { if (MARKERP (object)) @@ -412,8 +421,9 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "Return t if OBJECT is a marker ( return Qnil; } -DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "Return t if OBJECT is a built-in function.") - (object) +DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, + doc: /* Return t if OBJECT is a built-in function. */) + (object) Lisp_Object object; { if (SUBRP (object)) @@ -422,8 +432,9 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "Return t if OBJECT is a built-in funct } DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, - 1, 1, 0, "Return t if OBJECT is a byte-compiled function object.") - (object) + 1, 1, 0, + doc: /* Return t if OBJECT is a byte-compiled function object. */) + (object) Lisp_Object object; { if (COMPILEDP (object)) @@ -432,8 +443,8 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, } DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, - "Return t if OBJECT is a character (an integer) or a string.") - (object) + doc: /* Return t if OBJECT is a character (an integer) or a string. */) + (object) register Lisp_Object object; { if (INTEGERP (object) || STRINGP (object)) @@ -441,8 +452,9 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, return Qnil; } -DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "Return t if OBJECT is an integer.") - (object) +DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, + doc: /* Return t if OBJECT is an integer. */) + (object) Lisp_Object object; { if (INTEGERP (object)) @@ -451,8 +463,8 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "Return t if OBJECT is an inte } DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0, - "Return t if OBJECT is an integer or a marker (editor pointer).") - (object) + doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) + (object) register Lisp_Object object; { if (MARKERP (object) || INTEGERP (object)) @@ -461,8 +473,8 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, } DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, - "Return t if OBJECT is a nonnegative integer.") - (object) + doc: /* Return t if OBJECT is a nonnegative integer. */) + (object) Lisp_Object object; { if (NATNUMP (object)) @@ -471,8 +483,8 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, - "Return t if OBJECT is a number (floating point or integer).") - (object) + doc: /* Return t if OBJECT is a number (floating point or integer). */) + (object) Lisp_Object object; { if (NUMBERP (object)) @@ -483,8 +495,8 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, DEFUN ("number-or-marker-p", Fnumber_or_marker_p, Snumber_or_marker_p, 1, 1, 0, - "Return t if OBJECT is a number or a marker.") - (object) + doc: /* Return t if OBJECT is a number or a marker. */) + (object) Lisp_Object object; { if (NUMBERP (object) || MARKERP (object)) @@ -493,8 +505,8 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, } DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, - "Return t if OBJECT is a floating point number.") - (object) + doc: /* Return t if OBJECT is a floating point number. */) + (object) Lisp_Object object; { if (FLOATP (object)) @@ -506,9 +518,9 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, /* Extract and set components of lists */ DEFUN ("car", Fcar, Scar, 1, 1, 0, - "Return the car of LIST. If arg is nil, return nil.\n\ -Error if arg is not nil and not a cons cell. See also `car-safe'.") - (list) + doc: /* Return the car of LIST. If arg is nil, return nil. +Error if arg is not nil and not a cons cell. See also `car-safe'. */) + (list) register Lisp_Object list; { while (1) @@ -523,8 +535,8 @@ Error if arg is not nil and not a cons cell. See also `car-safe'.") } DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, - "Return the car of OBJECT if it is a cons cell, or else nil.") - (object) + doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */) + (object) Lisp_Object object; { if (CONSP (object)) @@ -534,10 +546,9 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, - "Return the cdr of LIST. If arg is nil, return nil.\n\ -Error if arg is not nil and not a cons cell. See also `cdr-safe'.") - - (list) + doc: /* Return the cdr of LIST. If arg is nil, return nil. +Error if arg is not nil and not a cons cell. See also `cdr-safe'. */) + (list) register Lisp_Object list; { while (1) @@ -552,8 +563,8 @@ Error if arg is not nil and not a cons cell. See also `cdr-safe'.") } DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, - "Return the cdr of OBJECT if it is a cons cell, or else nil.") - (object) + doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */) + (object) Lisp_Object object; { if (CONSP (object)) @@ -563,41 +574,42 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, - "Set the car of CELL to be NEWCAR. Returns NEWCAR.") - (cell, newcar) + doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */) + (cell, newcar) register Lisp_Object cell, newcar; { if (!CONSP (cell)) cell = wrong_type_argument (Qconsp, cell); CHECK_IMPURE (cell); - XCAR (cell) = newcar; + XSETCAR (cell, newcar); return newcar; } DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, - "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.") - (cell, newcdr) + doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */) + (cell, newcdr) register Lisp_Object cell, newcdr; { if (!CONSP (cell)) cell = wrong_type_argument (Qconsp, cell); CHECK_IMPURE (cell); - XCDR (cell) = newcdr; + XSETCDR (cell, newcdr); return newcdr; } /* Extract and set components of symbols */ -DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "Return t if SYMBOL's value is not void.") - (symbol) +DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, + doc: /* Return t if SYMBOL's value is not void. */) + (symbol) register Lisp_Object symbol; { Lisp_Object valcontents; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); - valcontents = XSYMBOL (symbol)->value; + valcontents = SYMBOL_VALUE (symbol); if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) @@ -606,32 +618,33 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "Return t if SYMBOL's value is not v return (EQ (valcontents, Qunbound) ? Qnil : Qt); } -DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "Return t if SYMBOL's function definition is not void.") - (symbol) +DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, + doc: /* Return t if SYMBOL's function definition is not void. */) + (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt); } -DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.") - (symbol) +DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, + doc: /* Make SYMBOL's value be void. */) + (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); - if (NILP (symbol) || EQ (symbol, Qt) - || (XSYMBOL (symbol)->name->data[0] == ':' - && EQ (XSYMBOL (symbol)->obarray, initial_obarray))) + CHECK_SYMBOL (symbol); + if (XSYMBOL (symbol)->constant) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); Fset (symbol, Qunbound); return symbol; } -DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.") - (symbol) +DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, + doc: /* Make SYMBOL's function definition be void. */) + (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); XSYMBOL (symbol)->function = Qunbound; @@ -639,41 +652,43 @@ DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's functi } DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, - "Return SYMBOL's function definition. Error if that is void.") - (symbol) + doc: /* Return SYMBOL's function definition. Error if that is void. */) + (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); if (EQ (XSYMBOL (symbol)->function, Qunbound)) return Fsignal (Qvoid_function, Fcons (symbol, Qnil)); return XSYMBOL (symbol)->function; } -DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.") - (symbol) +DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, + doc: /* Return SYMBOL's property list. */) + (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); return XSYMBOL (symbol)->plist; } -DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.") - (symbol) +DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, + doc: /* Return SYMBOL's name, a string. */) + (symbol) register Lisp_Object symbol; { register Lisp_Object name; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); XSETSTRING (name, XSYMBOL (symbol)->name); return name; } DEFUN ("fset", Ffset, Sfset, 2, 2, 0, - "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.") - (symbol, definition) + doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) + (symbol, definition) register Lisp_Object symbol, definition; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound)) @@ -690,9 +705,9 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, } DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, - "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.\n\ -Associates the function with the current load file, if any.") - (symbol, definition) + doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. +Associates the function with the current load file, if any. */) + (symbol, definition) register Lisp_Object symbol, definition; { definition = Ffset (symbol, definition); @@ -701,22 +716,22 @@ Associates the function with the current load file, if any.") } DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, - "Set SYMBOL's property list to NEWVAL, and return NEWVAL.") - (symbol, newplist) + doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. */) + (symbol, newplist) register Lisp_Object symbol, newplist; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); XSYMBOL (symbol)->plist = newplist; return newplist; } DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0, - "Return minimum and maximum number of args allowed for SUBR.\n\ -SUBR must be a built-in function.\n\ -The returned value is a pair (MIN . MAX). MIN is the minimum number\n\ -of args. MAX is the maximum number or the symbol `many', for a\n\ -function with `&rest' args, or `unevalled' for a special form.") - (subr) + doc: /* Return minimum and maximum number of args allowed for SUBR. +SUBR must be a built-in function. +The returned value is a pair (MIN . MAX). MIN is the minimum number +of args. MAX is the maximum number or the symbol `many', for a +function with `&rest' args, or `unevalled' for a special form. */) + (subr) Lisp_Object subr; { short minargs, maxargs; @@ -732,8 +747,68 @@ function with `&rest' args, or `unevalled' for a special form.") return Fcons (make_number (minargs), make_number (maxargs)); } +DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, + doc: /* Return the interactive form of SUBR or nil if none. +SUBR must be a built-in function. Value, if non-nil, is a list +\(interactive SPEC). */) + (subr) + Lisp_Object subr; +{ + if (!SUBRP (subr)) + wrong_type_argument (Qsubrp, subr); + if (XSUBR (subr)->prompt) + return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); + return Qnil; +} + -/* Getting and setting values of symbols */ +/*********************************************************************** + Getting and Setting Values of Symbols + ***********************************************************************/ + +/* Return the symbol holding SYMBOL's value. Signal + `cyclic-variable-indirection' if SYMBOL's chain of variable + indirections contains a loop. */ + +Lisp_Object +indirect_variable (symbol) + Lisp_Object symbol; +{ + Lisp_Object tortoise, hare; + + hare = tortoise = symbol; + + while (XSYMBOL (hare)->indirect_variable) + { + hare = XSYMBOL (hare)->value; + if (!XSYMBOL (hare)->indirect_variable) + break; + + hare = XSYMBOL (hare)->value; + tortoise = XSYMBOL (tortoise)->value; + + if (EQ (hare, tortoise)) + Fsignal (Qcyclic_variable_indirection, Fcons (symbol, Qnil)); + } + + return hare; +} + + +DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, + doc: /* Return the variable at the end of OBJECT's variable chain. +If OBJECT is a symbol, follow all variable indirections and return the final +variable. If OBJECT is not a symbol, just return it. +Signal a cyclic-variable-indirection error if there is a loop in the +variable chain of symbols. */) + (object) + Lisp_Object object; +{ + if (SYMBOLP (object)) + object = indirect_variable (object); + return object; +} + /* Given the raw contents of a symbol value cell, return the Lisp value of the symbol. @@ -773,12 +848,16 @@ do_symval_forwarding (valcontents) /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the buffer-independent contents of the value cell: forwarded just one - step past the buffer-localness. */ + step past the buffer-localness. + + BUF non-zero means set the value in buffer BUF instead of the + current buffer. This only plays a role for per-buffer variables. */ void -store_symval_forwarding (symbol, valcontents, newval) +store_symval_forwarding (symbol, valcontents, newval, buf) Lisp_Object symbol; register Lisp_Object valcontents, newval; + struct buffer *buf; { switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) { @@ -786,7 +865,7 @@ store_symval_forwarding (symbol, valcontents, newval) switch (XMISCTYPE (valcontents)) { case Lisp_Misc_Intfwd: - CHECK_NUMBER (newval, 1); + CHECK_NUMBER (newval); *XINTFWD (valcontents)->intvar = XINT (newval); if (*XINTFWD (valcontents)->intvar != XINT (newval)) error ("Value out of range for variable `%s'", @@ -814,14 +893,18 @@ store_symval_forwarding (symbol, valcontents, newval) && XTYPE (newval) != XINT (type)) buffer_slot_type_mismatch (offset); - PER_BUFFER_VALUE (current_buffer, offset) = newval; + if (buf == NULL) + buf = current_buffer; + PER_BUFFER_VALUE (buf, offset) = newval; } break; case Lisp_Misc_Kboard_Objfwd: - (*(Lisp_Object *)((char *)current_kboard - + XKBOARD_OBJFWD (valcontents)->offset)) - = newval; + { + char *base = (char *) current_kboard; + char *p = base + XKBOARD_OBJFWD (valcontents)->offset; + *(Lisp_Object *) p = newval; + } break; default: @@ -831,12 +914,12 @@ store_symval_forwarding (symbol, valcontents, newval) default: def: - valcontents = XSYMBOL (symbol)->value; + valcontents = SYMBOL_VALUE (symbol); if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval; else - XSYMBOL (symbol)->value = newval; + SET_SYMBOL_VALUE (symbol, newval); } } @@ -849,7 +932,7 @@ swap_in_global_binding (symbol) { Lisp_Object valcontents, cdr; - valcontents = XSYMBOL (symbol)->value; + valcontents = SYMBOL_VALUE (symbol); if (!BUFFER_LOCAL_VALUEP (valcontents) && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) abort (); @@ -860,8 +943,8 @@ swap_in_global_binding (symbol) do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); /* Select the global binding in the symbol. */ - XCAR (cdr) = cdr; - store_symval_forwarding (symbol, valcontents, XCDR (cdr)); + XSETCAR (cdr, cdr); + store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL); /* Indicate that the global binding is set up now. */ XBUFFER_LOCAL_VALUE (valcontents)->frame = Qnil; @@ -882,6 +965,7 @@ swap_in_symval_forwarding (symbol, valcontents) Lisp_Object symbol, valcontents; { register Lisp_Object tem1; + tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (NILP (tem1) @@ -889,6 +973,9 @@ swap_in_symval_forwarding (symbol, valcontents) || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))) { + if (XSYMBOL (symbol)->indirect_variable) + symbol = indirect_variable (symbol); + /* Unload the previously loaded binding. */ tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); Fsetcdr (tem1, @@ -910,12 +997,12 @@ swap_in_symval_forwarding (symbol, valcontents) XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; /* Load the new binding. */ - XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr) = tem1; + XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1); XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer); XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - Fcdr (tem1)); + Fcdr (tem1), NULL); } return XBUFFER_LOCAL_VALUE (valcontents)->realvalue; } @@ -932,13 +1019,13 @@ find_symbol_value (symbol) { register Lisp_Object valcontents; register Lisp_Object val; - CHECK_SYMBOL (symbol, 0); - valcontents = XSYMBOL (symbol)->value; + + CHECK_SYMBOL (symbol); + valcontents = SYMBOL_VALUE (symbol); if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) - valcontents = swap_in_symval_forwarding (symbol, valcontents, - current_buffer); + valcontents = swap_in_symval_forwarding (symbol, valcontents); if (MISCP (valcontents)) { @@ -968,8 +1055,8 @@ find_symbol_value (symbol) } DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, - "Return SYMBOL's value. Error if that is void.") - (symbol) + doc: /* Return SYMBOL's value. Error if that is void. */) + (symbol) Lisp_Object symbol; { Lisp_Object val; @@ -982,8 +1069,8 @@ DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, } DEFUN ("set", Fset, Sset, 2, 2, 0, - "Set SYMBOL's value to NEWVAL, and return NEWVAL.") - (symbol, newval) + doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */) + (symbol, newval) register Lisp_Object symbol, newval; { return set_internal (symbol, newval, current_buffer, 0); @@ -999,13 +1086,18 @@ let_shadows_buffer_binding_p (symbol) struct specbinding *p; for (p = specpdl_ptr - 1; p >= specpdl; p--) - if (p->func == 0 - && CONSP (p->symbol) - && EQ (symbol, XCAR (p->symbol)) - && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) - return 1; + if (p->func == NULL + && CONSP (p->symbol)) + { + Lisp_Object let_bound_symbol = XCAR (p->symbol); + if ((EQ (symbol, let_bound_symbol) + || (XSYMBOL (let_bound_symbol)->indirect_variable + && EQ (symbol, indirect_variable (let_bound_symbol)))) + && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) + break; + } - return 0; + return p >= specpdl; } /* Store the value NEWVAL into SYMBOL. @@ -1024,7 +1116,7 @@ set_internal (symbol, newval, buf, bindflag) { int voide = EQ (newval, Qunbound); - register Lisp_Object valcontents, tem1, current_alist_element; + register Lisp_Object valcontents, innercontents, tem1, current_alist_element; if (buf == 0) buf = current_buffer; @@ -1033,14 +1125,14 @@ set_internal (symbol, newval, buf, bindflag) if (NILP (buf->name)) return newval; - CHECK_SYMBOL (symbol, 0); - if (NILP (symbol) || EQ (symbol, Qt) - || (XSYMBOL (symbol)->name->data[0] == ':' - && EQ (XSYMBOL (symbol)->obarray, initial_obarray) - && !EQ (newval, symbol))) + CHECK_SYMBOL (symbol); + if (SYMBOL_CONSTANT_P (symbol) + && (NILP (Fkeywordp (symbol)) + || !EQ (newval, SYMBOL_VALUE (symbol)))) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); - valcontents = XSYMBOL (symbol)->value; + innercontents = valcontents = SYMBOL_VALUE (symbol); + if (BUFFER_OBJFWDP (valcontents)) { int offset = XBUFFER_OBJFWD (valcontents)->offset; @@ -1050,11 +1142,12 @@ set_internal (symbol, newval, buf, bindflag) && !let_shadows_buffer_binding_p (symbol)) SET_PER_BUFFER_VALUE_P (buf, idx, 1); } - else if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) { /* valcontents is a struct Lisp_Buffer_Local_Value. */ + if (XSYMBOL (symbol)->indirect_variable) + symbol = indirect_variable (symbol); /* What binding is loaded right now? */ current_alist_element @@ -1123,22 +1216,41 @@ set_internal (symbol, newval, buf, bindflag) } /* Record which binding is now loaded. */ - XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr) - = tem1; + XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, + tem1); /* Set `buffer' and `frame' slots for thebinding now loaded. */ XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf); XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; } - valcontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue; + innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue; } /* If storing void (making the symbol void), forward only through buffer-local indicator, not through Lisp_Objfwd, etc. */ if (voide) - store_symval_forwarding (symbol, Qnil, newval); + store_symval_forwarding (symbol, Qnil, newval, buf); else - store_symval_forwarding (symbol, valcontents, newval); + store_symval_forwarding (symbol, innercontents, newval, buf); + + /* If we just set a variable whose current binding is frame-local, + store the new value in the frame parameter too. */ + + if (BUFFER_LOCAL_VALUEP (valcontents) + || SOME_BUFFER_LOCAL_VALUEP (valcontents)) + { + /* What binding is loaded right now? */ + current_alist_element + = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); + + /* If the current buffer is not the buffer whose binding is + loaded, or if there may be frame-local bindings and the frame + isn't the right one, or if it's a Lisp_Buffer_Local_Value and + the default binding is loaded, the loaded binding may be the + wrong one. */ + if (XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) + XSETCDR (current_alist_element, newval); + } return newval; } @@ -1154,8 +1266,8 @@ default_value (symbol) { register Lisp_Object valcontents; - CHECK_SYMBOL (symbol, 0); - valcontents = XSYMBOL (symbol)->value; + CHECK_SYMBOL (symbol); + valcontents = SYMBOL_VALUE (symbol); /* For a built-in buffer-local variable, get the default value rather than letting do_symval_forwarding get the current value. */ @@ -1188,10 +1300,10 @@ default_value (symbol) } DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0, - "Return t if SYMBOL has a non-void default value.\n\ -This is the value that is seen in buffers that do not have their own values\n\ -for this variable.") - (symbol) + doc: /* Return t if SYMBOL has a non-void default value. +This is the value that is seen in buffers that do not have their own values +for this variable. */) + (symbol) Lisp_Object symbol; { register Lisp_Object value; @@ -1201,11 +1313,11 @@ for this variable.") } DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0, - "Return SYMBOL's default value.\n\ -This is the value that is seen in buffers that do not have their own values\n\ -for this variable. The default value is meaningful for variables with\n\ -local bindings in certain buffers.") - (symbol) + doc: /* Return SYMBOL's default value. +This is the value that is seen in buffers that do not have their own values +for this variable. The default value is meaningful for variables with +local bindings in certain buffers. */) + (symbol) Lisp_Object symbol; { register Lisp_Object value; @@ -1217,16 +1329,16 @@ local bindings in certain buffers.") } DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, - "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\ -The default value is seen in buffers that do not have their own values\n\ -for this variable.") - (symbol, value) + doc: /* Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated. +The default value is seen in buffers that do not have their own values +for this variable. */) + (symbol, value) Lisp_Object symbol, value; { register Lisp_Object valcontents, current_alist_element, alist_element_buffer; - CHECK_SYMBOL (symbol, 0); - valcontents = XSYMBOL (symbol)->value; + CHECK_SYMBOL (symbol); + valcontents = SYMBOL_VALUE (symbol); /* Handle variables like case-fold-search that have special slots in the buffer. Make them work apparently like Lisp_Buffer_Local_Value @@ -1256,32 +1368,34 @@ for this variable.") return Fset (symbol, value); /* Store new value into the DEFAULT-VALUE slot. */ - XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr) = value; + XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value); /* If the default binding is now loaded, set the REALVALUE slot too. */ current_alist_element = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); alist_element_buffer = Fcar (current_alist_element); if (EQ (alist_element_buffer, current_alist_element)) - store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - value); + store_symval_forwarding (symbol, + XBUFFER_LOCAL_VALUE (valcontents)->realvalue, + value, NULL); return value; } DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, - "Set the default value of variable VAR to VALUE.\n\ -VAR, the variable name, is literal (not evaluated);\n\ -VALUE is an expression and it is evaluated.\n\ -The default value of a variable is seen in buffers\n\ -that do not have their own values for the variable.\n\ -\n\ -More generally, you can use multiple variables and values, as in\n\ - (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\ -This sets each SYMBOL's default value to the corresponding VALUE.\n\ -The VALUE for the Nth SYMBOL can refer to the new default values\n\ -of previous SYMs.") - (args) + doc: /* Set the default value of variable VAR to VALUE. +VAR, the variable name, is literal (not evaluated); +VALUE is an expression and it is evaluated. +The default value of a variable is seen in buffers +that do not have their own values for the variable. + +More generally, you can use multiple variables and values, as in + (setq-default SYMBOL VALUE SYMBOL VALUE...) +This sets each SYMBOL's default value to the corresponding VALUE. +The VALUE for the Nth SYMBOL can refer to the new default values +of previous SYMs. +usage: (setq-default SYMBOL VALUE [SYMBOL VALUE...]) */) + (args) Lisp_Object args; { register Lisp_Object args_left; @@ -1310,24 +1424,24 @@ of previous SYMs.") /* Lisp functions for creating and removing buffer-local variables. */ DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local, - 1, 1, "vMake Variable Buffer Local: ", - "Make VARIABLE become buffer-local whenever it is set.\n\ -At any time, the value for the current buffer is in effect,\n\ -unless the variable has never been set in this buffer,\n\ -in which case the default value is in effect.\n\ -Note that binding the variable with `let', or setting it while\n\ -a `let'-style binding made in this buffer is in effect,\n\ -does not make the variable buffer-local.\n\ -\n\ -The function `default-value' gets the default value and `set-default' sets it.") - (variable) + 1, 1, "vMake Variable Buffer Local: ", + doc: /* Make VARIABLE become buffer-local whenever it is set. +At any time, the value for the current buffer is in effect, +unless the variable has never been set in this buffer, +in which case the default value is in effect. +Note that binding the variable with `let', or setting it while +a `let'-style binding made in this buffer is in effect, +does not make the variable buffer-local. + +The function `default-value' gets the default value and `set-default' sets it. */) + (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents, newval; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data); @@ -1335,52 +1449,52 @@ The function `default-value' gets the default value and `set-default' sets it.") return variable; if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) { - XMISCTYPE (XSYMBOL (variable)->value) = Lisp_Misc_Buffer_Local_Value; + XMISCTYPE (SYMBOL_VALUE (variable)) = Lisp_Misc_Buffer_Local_Value; return variable; } if (EQ (valcontents, Qunbound)) - XSYMBOL (variable)->value = Qnil; + SET_SYMBOL_VALUE (variable, Qnil); tem = Fcons (Qnil, Fsymbol_value (variable)); - XCAR (tem) = tem; + XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value; + XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer (); XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - XSYMBOL (variable)->value = newval; + SET_SYMBOL_VALUE (variable, newval); return variable; } DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable, - 1, 1, "vMake Local Variable: ", - "Make VARIABLE have a separate value in the current buffer.\n\ -Other buffers will continue to share a common default value.\n\ -\(The buffer-local value of VARIABLE starts out as the same value\n\ -VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\ -See also `make-variable-buffer-local'.\n\ -\n\ -If the variable is already arranged to become local when set,\n\ -this function causes a local value to exist for this buffer,\n\ -just as setting the variable would do.\n\ -\n\ -This function returns VARIABLE, and therefore\n\ - (set (make-local-variable 'VARIABLE) VALUE-EXP)\n\ -works.\n\ -\n\ -Do not use `make-local-variable' to make a hook variable buffer-local.\n\ -Use `make-local-hook' instead.") - (variable) + 1, 1, "vMake Local Variable: ", + doc: /* Make VARIABLE have a separate value in the current buffer. +Other buffers will continue to share a common default value. +\(The buffer-local value of VARIABLE starts out as the same value +VARIABLE previously had. If VARIABLE was void, it remains void.\) +See also `make-variable-buffer-local'. + +If the variable is already arranged to become local when set, +this function causes a local value to exist for this buffer, +just as setting the variable would do. + +This function returns VARIABLE, and therefore + (set (make-local-variable 'VARIABLE) VALUE-EXP) +works. + +Do not use `make-local-variable' to make a hook variable buffer-local. +Instead, use `add-hook' and specify t for the LOCAL argument. */) + (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data); @@ -1398,17 +1512,17 @@ Use `make-local-hook' instead.") { Lisp_Object newval; tem = Fcons (Qnil, do_symval_forwarding (valcontents)); - XCAR (tem) = tem; + XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value; + XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - XSYMBOL (variable)->value = newval; + SET_SYMBOL_VALUE (variable, newval);; } /* Make sure this buffer has its own value of symbol. */ tem = Fassq (variable, current_buffer->local_var_alist); @@ -1420,7 +1534,7 @@ Use `make-local-hook' instead.") find_symbol_value (variable); current_buffer->local_var_alist - = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->cdr)), + = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->cdr)), current_buffer->local_var_alist); /* Make sure symbol does not think it is set up for this buffer; @@ -1428,7 +1542,7 @@ Use `make-local-hook' instead.") { Lisp_Object *pvalbuf; - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (current_buffer == XBUFFER (*pvalbuf)) @@ -1441,25 +1555,25 @@ Use `make-local-hook' instead.") for this buffer now. If C code modifies the variable before we load the binding in, then that new value will clobber the default binding the next time we unload it. */ - valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->realvalue; + valcontents = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->realvalue; if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents)) - swap_in_symval_forwarding (variable, XSYMBOL (variable)->value); + swap_in_symval_forwarding (variable, SYMBOL_VALUE (variable)); return variable; } DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable, - 1, 1, "vKill Local Variable: ", - "Make VARIABLE no longer have a separate value in the current buffer.\n\ -From now on the default value will apply in this buffer.") - (variable) + 1, 1, "vKill Local Variable: ", + doc: /* Make VARIABLE no longer have a separate value in the current buffer. +From now on the default value will apply in this buffer. */) + (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); if (BUFFER_OBJFWDP (valcontents)) { @@ -1491,7 +1605,7 @@ From now on the default value will apply in this buffer.") forwarded objects won't work right. */ { Lisp_Object *pvalbuf; - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (current_buffer == XBUFFER (*pvalbuf)) { @@ -1507,22 +1621,22 @@ From now on the default value will apply in this buffer.") /* Lisp functions for creating and removing buffer-local variables. */ DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local, - 1, 1, "vMake Variable Frame Local: ", - "Enable VARIABLE to have frame-local bindings.\n\ -When a frame-local binding exists in the current frame,\n\ -it is in effect whenever the current buffer has no buffer-local binding.\n\ -A frame-local binding is actual a frame parameter value;\n\ -thus, any given frame has a local binding for VARIABLE\n\ -if it has a value for the frame parameter named VARIABLE.\n\ -See `modify-frame-parameters'.") - (variable) + 1, 1, "vMake Variable Frame Local: ", + doc: /* Enable VARIABLE to have frame-local bindings. +When a frame-local binding exists in the current frame, +it is in effect whenever the current buffer has no buffer-local binding. +A frame-local binding is actual a frame parameter value; +thus, any given frame has a local binding for VARIABLE +if it has a value for the frame parameter named VARIABLE. +See `modify-frame-parameters'. */) + (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents, newval; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) || BUFFER_OBJFWDP (valcontents)) error ("Symbol %s may not be frame-local", XSYMBOL (variable)->name->data); @@ -1535,27 +1649,27 @@ See `modify-frame-parameters'.") } if (EQ (valcontents, Qunbound)) - XSYMBOL (variable)->value = Qnil; + SET_SYMBOL_VALUE (variable, Qnil); tem = Fcons (Qnil, Fsymbol_value (variable)); - XCAR (tem) = tem; + XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value; + XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 1; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - XSYMBOL (variable)->value = newval; + SET_SYMBOL_VALUE (variable, newval); return variable; } DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, - 1, 2, 0, - "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\ -BUFFER defaults to the current buffer.") - (variable, buffer) + 1, 2, 0, + doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER. +BUFFER defaults to the current buffer. */) + (variable, buffer) register Lisp_Object variable, buffer; { Lisp_Object valcontents; @@ -1565,17 +1679,19 @@ BUFFER defaults to the current buffer.") buf = current_buffer; else { - CHECK_BUFFER (buffer, 0); + CHECK_BUFFER (buffer); buf = XBUFFER (buffer); } - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object tail, elt; + + variable = indirect_variable (variable); for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); @@ -1594,10 +1710,10 @@ BUFFER defaults to the current buffer.") } DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, - 1, 2, 0, - "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\ -BUFFER defaults to the current buffer.") - (variable, buffer) + 1, 2, 0, + doc: /* Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. +BUFFER defaults to the current buffer. */) + (variable, buffer) register Lisp_Object variable, buffer; { Lisp_Object valcontents; @@ -1607,13 +1723,13 @@ BUFFER defaults to the current buffer.") buf = current_buffer; else { - CHECK_BUFFER (buffer, 0); + CHECK_BUFFER (buffer); buf = XBUFFER (buffer); } - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); /* This means that make-variable-buffer-local was done. */ if (BUFFER_LOCAL_VALUEP (valcontents)) @@ -1670,15 +1786,15 @@ indirect_function (object) } DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0, - "Return the function at the end of OBJECT's function chain.\n\ -If OBJECT is a symbol, follow all function indirections and return the final\n\ -function binding.\n\ -If OBJECT is not a symbol, just return it.\n\ -Signal a void-function error if the final symbol is unbound.\n\ -Signal a cyclic-function-indirection error if there is a loop in the\n\ -function chain of symbols.") - (object) - register Lisp_Object object; + doc: /* Return the function at the end of OBJECT's function chain. +If OBJECT is a symbol, follow all function indirections and return the final +function binding. +If OBJECT is not a symbol, just return it. +Signal a void-function error if the final symbol is unbound. +Signal a cyclic-function-indirection error if there is a loop in the +function chain of symbols. */) + (object) + register Lisp_Object object; { Lisp_Object result; @@ -1692,16 +1808,16 @@ function chain of symbols.") /* Extract and set vector and string elements */ DEFUN ("aref", Faref, Saref, 2, 2, 0, - "Return the element of ARRAY at index IDX.\n\ -ARRAY may be a vector, a string, a char-table, a bool-vector,\n\ -or a byte-code object. IDX starts at 0.") - (array, idx) + doc: /* Return the element of ARRAY at index IDX. +ARRAY may be a vector, a string, a char-table, a bool-vector, +or a byte-code object. IDX starts at 0. */) + (array, idx) register Lisp_Object array; Lisp_Object idx; { register int idxval; - CHECK_NUMBER (idx, 1); + CHECK_NUMBER (idx); idxval = XINT (idx); if (STRINGP (array)) { @@ -1731,6 +1847,8 @@ or a byte-code object. IDX starts at 0.") { Lisp_Object val; + val = Qnil; + if (idxval < 0) args_out_of_range (array, idx); if (idxval < CHAR_TABLE_ORDINARY_SLOTS) @@ -1801,7 +1919,7 @@ or a byte-code object. IDX starts at 0.") } else { - int size; + int size = 0; if (VECTORP (array)) size = XVECTOR (array)->size; else if (COMPILEDP (array)) @@ -1815,17 +1933,22 @@ or a byte-code object. IDX starts at 0.") } } +/* Don't use alloca for relocating string data larger than this, lest + we overflow their stack. The value is the same as what used in + fns.c for base64 handling. */ +#define MAX_ALLOCA 16*1024 + DEFUN ("aset", Faset, Saset, 3, 3, 0, - "Store into the element of ARRAY at index IDX the value NEWELT.\n\ -ARRAY may be a vector, a string, a char-table or a bool-vector.\n\ -IDX starts at 0.") - (array, idx, newelt) + doc: /* Store into the element of ARRAY at index IDX the value NEWELT. +ARRAY may be a vector, a string, a char-table or a bool-vector. +IDX starts at 0. */) + (array, idx, newelt) register Lisp_Object array; Lisp_Object idx, newelt; { register int idxval; - CHECK_NUMBER (idx, 1); + CHECK_NUMBER (idx); idxval = XINT (idx); if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) && ! CHAR_TABLE_P (array)) @@ -1896,41 +2019,81 @@ IDX starts at 0.") } else if (STRING_MULTIBYTE (array)) { - int idxval_byte, new_len, actual_len; - int prev_byte; - unsigned char *p, workbuf[MAX_MULTIBYTE_LENGTH], *str = workbuf; + int idxval_byte, prev_bytes, new_bytes; + unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; if (idxval < 0 || idxval >= XSTRING (array)->size) args_out_of_range (array, idx); + CHECK_NUMBER (newelt); idxval_byte = string_char_to_byte (array, idxval); - p = &XSTRING (array)->data[idxval_byte]; - - actual_len = MULTIBYTE_FORM_LENGTH (p, STRING_BYTES (XSTRING (array))); - CHECK_NUMBER (newelt, 2); - new_len = CHAR_STRING (XINT (newelt), str); - if (actual_len != new_len) - error ("Attempt to change byte length of a string"); - - /* We can't accept a change causing byte combining. */ - if (!ASCII_BYTE_P (*str) - && ((idxval > 0 && !CHAR_HEAD_P (*str) - && (prev_byte = string_char_to_byte (array, idxval - 1), - BYTES_BY_CHAR_HEAD (XSTRING (array)->data[prev_byte]) - > idxval_byte - prev_byte)) - || (idxval < XSTRING (array)->size - 1 - && !CHAR_HEAD_P (p[actual_len]) - && new_len < BYTES_BY_CHAR_HEAD (*str)))) - error ("Attempt to change char length of a string"); - while (new_len--) - *p++ = *str++; + p1 = &XSTRING (array)->data[idxval_byte]; + PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes); + new_bytes = CHAR_STRING (XINT (newelt), p0); + if (prev_bytes != new_bytes) + { + /* We must relocate the string data. */ + int nchars = XSTRING (array)->size; + int nbytes = STRING_BYTES (XSTRING (array)); + unsigned char *str; + + str = (nbytes <= MAX_ALLOCA + ? (unsigned char *) alloca (nbytes) + : (unsigned char *) xmalloc (nbytes)); + bcopy (XSTRING (array)->data, str, nbytes); + allocate_string_data (XSTRING (array), nchars, + nbytes + new_bytes - prev_bytes); + bcopy (str, XSTRING (array)->data, idxval_byte); + p1 = XSTRING (array)->data + idxval_byte; + bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, + nbytes - (idxval_byte + prev_bytes)); + if (nbytes > MAX_ALLOCA) + xfree (str); + clear_string_char_byte_cache (); + } + while (new_bytes--) + *p1++ = *p0++; } else { if (idxval < 0 || idxval >= XSTRING (array)->size) args_out_of_range (array, idx); - CHECK_NUMBER (newelt, 2); - XSTRING (array)->data[idxval] = XINT (newelt); + CHECK_NUMBER (newelt); + + if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) + XSTRING (array)->data[idxval] = XINT (newelt); + else + { + /* We must relocate the string data while converting it to + multibyte. */ + int idxval_byte, prev_bytes, new_bytes; + unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; + unsigned char *origstr = XSTRING (array)->data, *str; + int nchars, nbytes; + + nchars = XSTRING (array)->size; + nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); + nbytes += count_size_as_multibyte (origstr + idxval, + nchars - idxval); + str = (nbytes <= MAX_ALLOCA + ? (unsigned char *) alloca (nbytes) + : (unsigned char *) xmalloc (nbytes)); + copy_text (XSTRING (array)->data, str, nchars, 0, 1); + PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, + prev_bytes); + new_bytes = CHAR_STRING (XINT (newelt), p0); + allocate_string_data (XSTRING (array), nchars, + nbytes + new_bytes - prev_bytes); + bcopy (str, XSTRING (array)->data, idxval_byte); + p1 = XSTRING (array)->data + idxval_byte; + while (new_bytes--) + *p1++ = *p0++; + bcopy (str + idxval_byte + prev_bytes, p1, + nbytes - (idxval_byte + prev_bytes)); + if (nbytes > MAX_ALLOCA) + xfree (str); + clear_string_char_byte_cache (); + } } return newelt; @@ -1945,11 +2108,11 @@ arithcompare (num1, num2, comparison) Lisp_Object num1, num2; enum comparison comparison; { - double f1, f2; + double f1 = 0, f2 = 0; int floatp = 0; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); if (FLOATP (num1) || FLOATP (num2)) { @@ -1996,60 +2159,61 @@ arithcompare (num1, num2, comparison) } DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, - "Return t if two args, both numbers or markers, are equal.") - (num1, num2) + doc: /* Return t if two args, both numbers or markers, are equal. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, equal); } DEFUN ("<", Flss, Slss, 2, 2, 0, - "Return t if first arg is less than second arg. Both must be numbers or markers.") - (num1, num2) + doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, less); } DEFUN (">", Fgtr, Sgtr, 2, 2, 0, - "Return t if first arg is greater than second arg. Both must be numbers or markers.") - (num1, num2) + doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, grtr); } DEFUN ("<=", Fleq, Sleq, 2, 2, 0, - "Return t if first arg is less than or equal to second arg.\n\ -Both must be numbers or markers.") - (num1, num2) + doc: /* Return t if first arg is less than or equal to second arg. +Both must be numbers or markers. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, less_or_equal); } DEFUN (">=", Fgeq, Sgeq, 2, 2, 0, - "Return t if first arg is greater than or equal to second arg.\n\ -Both must be numbers or markers.") - (num1, num2) + doc: /* Return t if first arg is greater than or equal to second arg. +Both must be numbers or markers. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, grtr_or_equal); } DEFUN ("/=", Fneq, Sneq, 2, 2, 0, - "Return t if first arg is not equal to second arg. Both must be numbers or markers.") - (num1, num2) + doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) + (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, notequal); } -DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "Return t if NUMBER is zero.") - (number) +DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, + doc: /* Return t if NUMBER is zero. */) + (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { @@ -2093,15 +2257,15 @@ cons_to_long (c) } DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, - "Convert NUMBER to a string by printing it in decimal.\n\ -Uses a minus sign if negative.\n\ -NUMBER may be an integer or a floating point number.") - (number) + doc: /* Convert NUMBER to a string by printing it in decimal. +Uses a minus sign if negative. +NUMBER may be an integer or a floating point number. */) + (number) Lisp_Object number; { char buffer[VALBITS]; - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { @@ -2142,14 +2306,14 @@ digit_to_number (character, base) } DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, - "Convert STRING to a number by parsing it as a decimal number.\n\ -This parses both integers and floating point numbers.\n\ -It ignores leading spaces and tabs.\n\ -\n\ -If BASE, interpret STRING as a number in that base. If BASE isn't\n\ -present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\ -If the base used is not 10, floating point is not recognized.") - (string, base) + doc: /* Convert STRING to a number by parsing it as a decimal number. +This parses both integers and floating point numbers. +It ignores leading spaces and tabs. + +If BASE, interpret STRING as a number in that base. If BASE isn't +present, base 10 is used. BASE must be between 2 and 16 (inclusive). +If the base used is not 10, floating point is not recognized. */) + (string, base) register Lisp_Object string, base; { register unsigned char *p; @@ -2157,13 +2321,13 @@ If the base used is not 10, floating point is not recognized.") int sign = 1; Lisp_Object val; - CHECK_STRING (string, 0); + CHECK_STRING (string); if (NILP (base)) b = 10; else { - CHECK_NUMBER (base, 1); + CHECK_NUMBER (base); b = XINT (base); if (b < 2 || b > 16) Fsignal (Qargs_out_of_range, Fcons (base, Qnil)); @@ -2197,10 +2361,7 @@ If the base used is not 10, floating point is not recognized.") v = v * b + digit; } - if (v > (EMACS_UINT) (VALMASK >> 1)) - val = make_float (sign * v); - else - val = make_number (sign * (int) v); + val = make_fixnum_or_float (sign * v); } return val; @@ -2208,9 +2369,20 @@ If the base used is not 10, floating point is not recognized.") enum arithop - { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; - -extern Lisp_Object float_arith_driver (); + { + Aadd, + Asub, + Amult, + Adiv, + Alogand, + Alogior, + Alogxor, + Amax, + Amin + }; + +static Lisp_Object float_arith_driver P_ ((double, int, enum arithop, + int, Lisp_Object *)); extern Lisp_Object fmod_float (); Lisp_Object @@ -2221,7 +2393,7 @@ arith_driver (code, nargs, args) { register Lisp_Object val; register int argnum; - register EMACS_INT accum; + register EMACS_INT accum = 0; register EMACS_INT next; switch (SWITCH_ENUM_CAST (code)) @@ -2230,32 +2402,43 @@ arith_driver (code, nargs, args) case Alogxor: case Aadd: case Asub: - accum = 0; break; + accum = 0; + break; case Amult: - accum = 1; break; + accum = 1; + break; case Alogand: - accum = -1; break; + accum = -1; + break; + default: + break; } for (argnum = 0; argnum < nargs; argnum++) { - val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); + /* Using args[argnum] as argument to CHECK_NUMBER_... */ + val = args[argnum]; + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); - if (FLOATP (val)) /* time to do serious math */ - return (float_arith_driver ((double) accum, argnum, code, - nargs, args)); - args[argnum] = val; /* runs into a compiler bug. */ + if (FLOATP (val)) + return float_arith_driver ((double) accum, argnum, code, + nargs, args); + args[argnum] = val; next = XINT (args[argnum]); switch (SWITCH_ENUM_CAST (code)) { - case Aadd: accum += next; break; + case Aadd: + accum += next; + break; case Asub: accum = argnum ? accum - next : nargs == 1 ? - next : next; break; - case Amult: accum *= next; break; + case Amult: + accum *= next; + break; case Adiv: - if (!argnum) accum = next; + if (!argnum) + accum = next; else { if (next == 0) @@ -2263,11 +2446,23 @@ arith_driver (code, nargs, args) accum /= next; } break; - case Alogand: accum &= next; break; - case Alogior: accum |= next; break; - case Alogxor: accum ^= next; break; - case Amax: if (!argnum || next > accum) accum = next; break; - case Amin: if (!argnum || next < accum) accum = next; break; + case Alogand: + accum &= next; + break; + case Alogior: + accum |= next; + break; + case Alogxor: + accum ^= next; + break; + case Amax: + if (!argnum || next > accum) + accum = next; + break; + case Amin: + if (!argnum || next < accum) + accum = next; + break; } } @@ -2278,7 +2473,7 @@ arith_driver (code, nargs, args) #undef isnan #define isnan(x) ((x) != (x)) -Lisp_Object +static Lisp_Object float_arith_driver (accum, argnum, code, nargs, args) double accum; register int argnum; @@ -2292,7 +2487,7 @@ float_arith_driver (accum, argnum, code, nargs, args) for (; argnum < nargs; argnum++) { val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) { @@ -2344,8 +2539,9 @@ float_arith_driver (accum, argnum, code, nargs, args) DEFUN ("+", Fplus, Splus, 0, MANY, 0, - "Return sum of any number of arguments, which are numbers or markers.") - (nargs, args) + doc: /* Return sum of any number of arguments, which are numbers or markers. +usage: (+ &rest NUMBERS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2353,10 +2549,11 @@ DEFUN ("+", Fplus, Splus, 0, MANY, 0, } DEFUN ("-", Fminus, Sminus, 0, MANY, 0, - "Negate number or subtract numbers or markers.\n\ -With one arg, negates it. With more than one arg,\n\ -subtracts all but the first from the first.") - (nargs, args) + doc: /* Negate number or subtract numbers or markers. +With one arg, negates it. With more than one arg, +subtracts all but the first from the first. +usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2364,8 +2561,9 @@ subtracts all but the first from the first.") } DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, - "Returns product of any number of arguments, which are numbers or markers.") - (nargs, args) + doc: /* Return product of any number of arguments, which are numbers or markers. +usage: (* &rest NUMBERS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2373,9 +2571,10 @@ DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, } DEFUN ("/", Fquo, Squo, 2, MANY, 0, - "Returns first argument divided by all the remaining arguments.\n\ -The arguments must be numbers or markers.") - (nargs, args) + doc: /* Return first argument divided by all the remaining arguments. +The arguments must be numbers or markers. +usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2383,15 +2582,15 @@ The arguments must be numbers or markers.") } DEFUN ("%", Frem, Srem, 2, 2, 0, - "Returns remainder of X divided by Y.\n\ -Both must be integers or markers.") - (x, y) + doc: /* Return remainder of X divided by Y. +Both must be integers or markers. */) + (x, y) register Lisp_Object x, y; { Lisp_Object val; - CHECK_NUMBER_COERCE_MARKER (x, 0); - CHECK_NUMBER_COERCE_MARKER (y, 1); + CHECK_NUMBER_COERCE_MARKER (x); + CHECK_NUMBER_COERCE_MARKER (y); if (XFASTINT (y) == 0) Fsignal (Qarith_error, Qnil); @@ -2424,17 +2623,17 @@ fmod (f1, f2) #endif /* ! HAVE_FMOD */ DEFUN ("mod", Fmod, Smod, 2, 2, 0, - "Returns X modulo Y.\n\ -The result falls between zero (inclusive) and Y (exclusive).\n\ -Both X and Y must be numbers or markers.") - (x, y) + doc: /* Return X modulo Y. +The result falls between zero (inclusive) and Y (exclusive). +Both X and Y must be numbers or markers. */) + (x, y) register Lisp_Object x, y; { Lisp_Object val; EMACS_INT i1, i2; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x, 0); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y, 1); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); @@ -2456,9 +2655,10 @@ Both X and Y must be numbers or markers.") } DEFUN ("max", Fmax, Smax, 1, MANY, 0, - "Return largest of all the arguments (which must be numbers or markers).\n\ -The value is always a number; markers are converted to numbers.") - (nargs, args) + doc: /* Return largest of all the arguments (which must be numbers or markers). +The value is always a number; markers are converted to numbers. +usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2466,9 +2666,10 @@ The value is always a number; markers are converted to numbers.") } DEFUN ("min", Fmin, Smin, 1, MANY, 0, - "Return smallest of all the arguments (which must be numbers or markers).\n\ -The value is always a number; markers are converted to numbers.") - (nargs, args) + doc: /* Return smallest of all the arguments (which must be numbers or markers). +The value is always a number; markers are converted to numbers. +usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2476,9 +2677,10 @@ The value is always a number; markers are converted to numbers.") } DEFUN ("logand", Flogand, Slogand, 0, MANY, 0, - "Return bitwise-and of all the arguments.\n\ -Arguments may be integers, or markers converted to integers.") - (nargs, args) + doc: /* Return bitwise-and of all the arguments. +Arguments may be integers, or markers converted to integers. +usage: (logand &rest INTS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2486,9 +2688,10 @@ Arguments may be integers, or markers converted to integers.") } DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, - "Return bitwise-or of all the arguments.\n\ -Arguments may be integers, or markers converted to integers.") - (nargs, args) + doc: /* Return bitwise-or of all the arguments. +Arguments may be integers, or markers converted to integers. +usage: (logior &rest INTS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2496,9 +2699,10 @@ Arguments may be integers, or markers converted to integers.") } DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, - "Return bitwise-exclusive-or of all the arguments.\n\ -Arguments may be integers, or markers converted to integers.") - (nargs, args) + doc: /* Return bitwise-exclusive-or of all the arguments. +Arguments may be integers, or markers converted to integers. +usage: (logxor &rest INTS-OR-MARKERS) */) + (nargs, args) int nargs; Lisp_Object *args; { @@ -2506,16 +2710,16 @@ Arguments may be integers, or markers converted to integers.") } DEFUN ("ash", Fash, Sash, 2, 2, 0, - "Return VALUE with its bits shifted left by COUNT.\n\ -If COUNT is negative, shifting is actually to the right.\n\ -In this case, the sign bit is duplicated.") - (value, count) + doc: /* Return VALUE with its bits shifted left by COUNT. +If COUNT is negative, shifting is actually to the right. +In this case, the sign bit is duplicated. */) + (value, count) register Lisp_Object value, count; { register Lisp_Object val; - CHECK_NUMBER (value, 0); - CHECK_NUMBER (count, 1); + CHECK_NUMBER (value); + CHECK_NUMBER (count); if (XINT (count) >= BITS_PER_EMACS_INT) XSETINT (val, 0); @@ -2529,16 +2733,16 @@ In this case, the sign bit is duplicated.") } DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, - "Return VALUE with its bits shifted left by COUNT.\n\ -If COUNT is negative, shifting is actually to the right.\n\ -In this case, zeros are shifted in on the left.") - (value, count) + doc: /* Return VALUE with its bits shifted left by COUNT. +If COUNT is negative, shifting is actually to the right. +In this case, zeros are shifted in on the left. */) + (value, count) register Lisp_Object value, count; { register Lisp_Object val; - CHECK_NUMBER (value, 0); - CHECK_NUMBER (count, 1); + CHECK_NUMBER (value); + CHECK_NUMBER (count); if (XINT (count) >= BITS_PER_EMACS_INT) XSETINT (val, 0); @@ -2552,12 +2756,12 @@ In this case, zeros are shifted in on the left.") } DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, - "Return NUMBER plus one. NUMBER may be a number or a marker.\n\ -Markers are converted to integers.") - (number) + doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. +Markers are converted to integers. */) + (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); @@ -2567,12 +2771,12 @@ Markers are converted to integers.") } DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, - "Return NUMBER minus one. NUMBER may be a number or a marker.\n\ -Markers are converted to integers.") - (number) + doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. +Markers are converted to integers. */) + (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); @@ -2582,11 +2786,11 @@ Markers are converted to integers.") } DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, - "Return the bitwise complement of NUMBER. NUMBER must be an integer.") - (number) + doc: /* Return the bitwise complement of NUMBER. NUMBER must be an integer. */) + (number) register Lisp_Object number; { - CHECK_NUMBER (number, 0); + CHECK_NUMBER (number); XSETINT (number, ~XINT (number)); return number; } @@ -2609,6 +2813,7 @@ syms_of_data () Qargs_out_of_range = intern ("args-out-of-range"); Qvoid_function = intern ("void-function"); Qcyclic_function_indirection = intern ("cyclic-function-indirection"); + Qcyclic_variable_indirection = intern ("cyclic-variable-indirection"); Qvoid_variable = intern ("void-variable"); Qsetting_constant = intern ("setting-constant"); Qinvalid_read_syntax = intern ("invalid-read-syntax"); @@ -2694,6 +2899,18 @@ syms_of_data () Fput (Qcyclic_function_indirection, Qerror_message, build_string ("Symbol's chain of function indirections contains a loop")); + Fput (Qcyclic_variable_indirection, Qerror_conditions, + Fcons (Qcyclic_variable_indirection, error_tail)); + Fput (Qcyclic_variable_indirection, Qerror_message, + build_string ("Symbol's chain of variable indirections contains a loop")); + + Qcircular_list = intern ("circular-list"); + staticpro (&Qcircular_list); + Fput (Qcircular_list, Qerror_conditions, + Fcons (Qcircular_list, error_tail)); + Fput (Qcircular_list, Qerror_message, + build_string ("List contains a loop")); + Fput (Qvoid_variable, Qerror_conditions, Fcons (Qvoid_variable, error_tail)); Fput (Qvoid_variable, Qerror_message, @@ -2892,6 +3109,8 @@ syms_of_data () staticpro (&Qbool_vector); staticpro (&Qhash_table); + defsubr (&Sindirect_variable); + defsubr (&Ssubr_interactive_form); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -2979,6 +3198,14 @@ syms_of_data () defsubr (&Ssubr_arity); XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; + + DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum, + doc: /* The largest value that is representable in a Lisp integer. */); + Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); + + DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum, + doc: /* The smallest value that is representable in a Lisp integer. */); + Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); } SIGTYPE