X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2fd1c3ad4b80d30772eb6858af45f462c35e03c6..534c20b22f89ffbe99a4d6a1035b74eacc544ee5:/src/data.c diff --git a/src/data.c b/src/data.c index 96a713daf9..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 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. @@ -19,23 +20,29 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#include - #include +#include +#include #include "lisp.h" #include "puresize.h" - -#ifndef standalone +#include "charset.h" #include "buffer.h" #include "keyboard.h" -#endif - +#include "frame.h" #include "syssignal.h" -#ifdef LISP_FLOAT_TYPE - #ifdef STDC_HEADERS -#include +#include +#endif + +/* 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 /* Work around a problem that happens because math.h on hpux 7 @@ -49,7 +56,6 @@ Boston, MA 02111-1307, USA. */ #endif #include -#endif /* LISP_FLOAT_TYPE */ #if !defined (atof) extern double atof (); @@ -59,34 +65,47 @@ 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; Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; +Lisp_Object Qtext_read_only; Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp; Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; -Lisp_Object Qbuffer_or_string_p; +Lisp_Object Qbuffer_or_string_p, Qkeywordp; Lisp_Object Qboundp, Qfboundp; Lisp_Object Qchar_table_p, Qvector_or_char_table_p; Lisp_Object Qcdr; -Lisp_Object Qad_advice_info, Qad_activate; +Lisp_Object Qad_advice_info, Qad_activate_internal; Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; Lisp_Object Qoverflow_error, Qunderflow_error; -#ifdef LISP_FLOAT_TYPE Lisp_Object Qfloatp; Lisp_Object Qnumberp, Qnumber_or_marker_p; -#endif static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; -static Lisp_Object Qfloat, Qwindow_configuration, Qprocess, Qwindow; +static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; +Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; -static Lisp_Object Qchar_table, Qbool_vector; +static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; +static Lisp_Object Qsubrp, Qmany, Qunevalled; + +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); +} -static Lisp_Object swap_in_symval_forwarding (); Lisp_Object wrong_type_argument (predicate, value) @@ -95,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); - 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) @@ -116,6 +126,7 @@ wrong_type_argument (predicate, value) return value; } +void pure_write_error () { error ("Attempt to modify read-only object"); @@ -157,8 +168,8 @@ sign_extend_lisp_int (num) /* Data type predicates */ DEFUN ("eq", Feq, Seq, 2, 2, 0, - "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)) @@ -166,8 +177,9 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0, return Qnil; } -DEFUN ("null", Fnull, Snull, 1, 1, 0, "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)) @@ -176,10 +188,10 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0, "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)) @@ -225,25 +237,23 @@ for example, (type-of 1) returns `integer'.") return Qchar_table; if (GC_BOOL_VECTOR_P (object)) return Qbool_vector; - -#ifdef MULTI_FRAME if (GC_FRAMEP (object)) return Qframe; -#endif + if (GC_HASH_TABLE_P (object)) + return Qhash_table; return Qvector; -#ifdef LISP_FLOAT_TYPE case Lisp_Float: return Qfloat; -#endif default: abort (); } } -DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "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)) @@ -251,8 +261,9 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.") return Qnil; } -DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.") - (object) +DEFUN ("atom", Fatom, Satom, 1, 1, 0, + doc: /* Return t if OBJECT is not a cons cell. This includes nil. */) + (object) Lisp_Object object; { if (CONSP (object)) @@ -260,8 +271,9 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell. This inc return Qt; } -DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list. This includes nil.") - (object) +DEFUN ("listp", Flistp, Slistp, 1, 1, 0, + doc: /* Return t if OBJECT is a list. This includes nil. */) + (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) @@ -269,8 +281,9 @@ DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list. This includes return Qnil; } -DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.") - (object) +DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, + doc: /* Return t if OBJECT is not a list. Lists include nil. */) + (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) @@ -278,8 +291,9 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list. Lists i return Qt; } -DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.") - (object) +DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, + doc: /* Return t if OBJECT is a symbol. */) + (object) Lisp_Object object; { if (SYMBOLP (object)) @@ -287,8 +301,25 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.") return Qnil; } -DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.") - (object) +/* Define this in C to avoid unnecessarily consing up the symbol + name. */ +DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0, + 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] == ':' + && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object)) + return Qt; + return Qnil; +} + +DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, + doc: /* Return t if OBJECT is a vector. */) + (object) Lisp_Object object; { if (VECTORP (object)) @@ -296,8 +327,9 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.") return Qnil; } -DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.") - (object) +DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, + doc: /* Return t if OBJECT is a string. */) + (object) Lisp_Object object; { if (STRINGP (object)) @@ -305,8 +337,20 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.") return Qnil; } -DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a char-table.") - (object) +DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p, + 1, 1, 0, + doc: /* Return t if OBJECT is a multibyte string. */) + (object) + Lisp_Object object; +{ + if (STRINGP (object) && STRING_MULTIBYTE (object)) + return Qt; + return Qnil; +} + +DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, + doc: /* Return t if OBJECT is a char-table. */) + (object) Lisp_Object object; { if (CHAR_TABLE_P (object)) @@ -316,8 +360,8 @@ DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p, Svector_or_char_table_p, 1, 1, 0, - "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)) @@ -325,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, "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)) @@ -334,18 +379,20 @@ DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "T if OBJECT is return Qnil; } -DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "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)) + if (VECTORP (object) || STRINGP (object) + || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) return Qt; return Qnil; } DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, - "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) @@ -354,8 +401,9 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, return Qnil; } -DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "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)) @@ -363,8 +411,9 @@ DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer. return Qnil; } -DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "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)) @@ -372,8 +421,9 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor return Qnil; } -DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "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)) @@ -382,8 +432,9 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.") } DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, - 1, 1, 0, "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)) @@ -392,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, - "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)) @@ -401,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, "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)) @@ -411,8 +463,8 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is an integer.") } DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0, - "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)) @@ -421,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, - "T if OBJECT is a nonnegative integer.") - (object) + doc: /* Return t if OBJECT is a nonnegative integer. */) + (object) Lisp_Object object; { if (NATNUMP (object)) @@ -431,8 +483,8 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, - "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)) @@ -443,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, - "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)) @@ -452,30 +504,29 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, return Qnil; } -#ifdef LISP_FLOAT_TYPE DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, - "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)) return Qt; return Qnil; } -#endif /* LISP_FLOAT_TYPE */ + /* 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) { if (CONSP (list)) - return XCONS (list)->car; + return XCAR (list); else if (EQ (list, Qnil)) return Qnil; else @@ -484,27 +535,26 @@ 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)) - return XCONS (object)->car; + return XCAR (object); else return Qnil; } 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) { if (CONSP (list)) - return XCONS (list)->cdr; + return XCDR (list); else if (EQ (list, Qnil)) return Qnil; else @@ -513,52 +563,53 @@ 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)) - return XCONS (object)->cdr; + return XCDR (object); else return Qnil; } 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); - XCONS (cell)->car = 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); - XCONS (cell)->cdr = newcdr; + XSETCDR (cell, newcdr); return newcdr; } /* Extract and set components of symbols */ -DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "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)) @@ -567,30 +618,33 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.") return (EQ (valcontents, Qunbound) ? Qnil : Qt); } -DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "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)) + 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; @@ -598,112 +652,163 @@ 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 NEWVAL, and return NEWVAL.") - (symbol, newdef) - register Lisp_Object symbol, newdef; + 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)) Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), Vautoload_queue); - XSYMBOL (symbol)->function = newdef; + XSYMBOL (symbol)->function = definition; /* Handle automatic advice activation */ if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info))) { - call2 (Qad_activate, symbol, Qnil); - newdef = XSYMBOL (symbol)->function; + call2 (Qad_activate_internal, symbol, Qnil); + definition = XSYMBOL (symbol)->function; } - return newdef; + return definition; } -/* This name should be removed once it is eliminated from elsewhere. */ - DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, - "Set SYMBOL's function definition to NEWDEF, and return NEWDEF.\n\ -Associates the function with the current load file, if any.") - (symbol, newdef) - register Lisp_Object symbol, newdef; + 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; { - CHECK_SYMBOL (symbol, 0); - if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound)) - Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), - Vautoload_queue); - XSYMBOL (symbol)->function = newdef; - /* Handle automatic advice activation */ - if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info))) - { - call2 (Qad_activate, symbol, Qnil); - newdef = XSYMBOL (symbol)->function; - } - LOADHIST_ATTACH (symbol); - return newdef; -} - -DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0, - "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\ -Associates the function with the current load file, if any.") - (symbol, newdef) - register Lisp_Object symbol, newdef; -{ - CHECK_SYMBOL (symbol, 0); - if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound)) - Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), - Vautoload_queue); - XSYMBOL (symbol)->function = newdef; - /* Handle automatic advice activation */ - if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info))) - { - call2 (Qad_activate, symbol, Qnil); - newdef = XSYMBOL (symbol)->function; - } + definition = Ffset (symbol, definition); LOADHIST_ATTACH (symbol); - return newdef; + return definition; } 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, + 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; + if (!SUBRP (subr)) + wrong_type_argument (Qsubrp, subr); + minargs = XSUBR (subr)->min_args; + maxargs = XSUBR (subr)->max_args; + if (maxargs == MANY) + return Fcons (make_number (minargs), Qmany); + else if (maxargs == UNEVALLED) + return Fcons (make_number (minargs), Qunevalled); + else + 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. @@ -731,7 +836,7 @@ do_symval_forwarding (valcontents) case Lisp_Misc_Buffer_Objfwd: offset = XBUFFER_OBJFWD (valcontents)->offset; - return *(Lisp_Object *)(offset + (char *)current_buffer); + return PER_BUFFER_VALUE (current_buffer, offset); case Lisp_Misc_Kboard_Objfwd: offset = XKBOARD_OBJFWD (valcontents)->offset; @@ -743,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))) { @@ -756,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'", @@ -776,19 +885,26 @@ store_symval_forwarding (symbol, valcontents, newval) int offset = XBUFFER_OBJFWD (valcontents)->offset; Lisp_Object type; - type = *(Lisp_Object *)(offset + (char *)&buffer_local_types); + type = PER_BUFFER_TYPE (offset); + if (XINT (type) == -1) + error ("Variable %s is read-only", XSYMBOL (symbol)->name->data); + if (! NILP (type) && ! NILP (newval) && XTYPE (newval) != XINT (type)) buffer_slot_type_mismatch (offset); - *(Lisp_Object *)(offset + (char *)current_buffer) = 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: @@ -798,58 +914,97 @@ 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)->car = newval; + XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval; else - XSYMBOL (symbol)->value = newval; + SET_SYMBOL_VALUE (symbol, newval); } } -/* Set up the buffer-local symbol SYMBOL for validity in the current - buffer. VALCONTENTS is the contents of its value cell. - Return the value forwarded one step past the buffer-local indicator. */ +/* Set up SYMBOL to refer to its global binding. + This makes it safe to alter the status of other bindings. */ -static Lisp_Object -swap_in_symval_forwarding (symbol, valcontents) - Lisp_Object symbol, valcontents; +void +swap_in_global_binding (symbol) + Lisp_Object symbol; { - /* valcontents is a pointer to a struct resembling the cons - (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)). + Lisp_Object valcontents, cdr; + + valcontents = SYMBOL_VALUE (symbol); + if (!BUFFER_LOCAL_VALUEP (valcontents) + && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) + abort (); + cdr = XBUFFER_LOCAL_VALUE (valcontents)->cdr; - CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's - local_var_alist, that being the element whose car is this - variable. Or it can be a pointer to the - (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have - an element in its alist for this variable. + /* Unload the previously loaded binding. */ + Fsetcdr (XCAR (cdr), + do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); + + /* Select the global binding in the symbol. */ + XSETCAR (cdr, cdr); + store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL); - If the current buffer is not BUFFER, we store the current - REALVALUE value into CURRENT-ALIST-ELEMENT, then find the - appropriate alist element for the buffer now current and set up - CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that - element, and store into BUFFER. + /* Indicate that the global binding is set up now. */ + XBUFFER_LOCAL_VALUE (valcontents)->frame = Qnil; + XBUFFER_LOCAL_VALUE (valcontents)->buffer = Qnil; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; +} - Note that REALVALUE can be a forwarding pointer. */ +/* Set up the buffer-local symbol SYMBOL for validity in the current buffer. + VALCONTENTS is the contents of its value cell, + which points to a struct Lisp_Buffer_Local_Value. + Return the value forwarded one step past the buffer-local stage. + This could be another forwarding pointer. */ + +static Lisp_Object +swap_in_symval_forwarding (symbol, valcontents) + Lisp_Object symbol, valcontents; +{ register Lisp_Object tem1; - tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; + + tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; - if (NILP (tem1) || current_buffer != XBUFFER (tem1)) + if (NILP (tem1) + || current_buffer != XBUFFER (tem1) + || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame + && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))) { - tem1 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; + if (XSYMBOL (symbol)->indirect_variable) + symbol = indirect_variable (symbol); + + /* Unload the previously loaded binding. */ + tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); Fsetcdr (tem1, - do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car)); + do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); + /* Choose the new binding. */ tem1 = assq_no_quit (symbol, current_buffer->local_var_alist); + XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; if (NILP (tem1)) - tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr; - XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1; - XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car, - current_buffer); - store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car, - Fcdr (tem1)); + { + if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) + tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist); + if (! NILP (tem1)) + XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1; + else + tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr; + } + else + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; + + /* Load the new binding. */ + 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), NULL); } - return XBUFFER_LOCAL_VALUE (valcontents)->car; + return XBUFFER_LOCAL_VALUE (valcontents)->realvalue; } /* Find the value of a symbol, returning Qunbound if it's not bound. @@ -862,10 +1017,11 @@ Lisp_Object find_symbol_value (symbol) Lisp_Object symbol; { - register Lisp_Object valcontents, tem1; + 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)) @@ -886,8 +1042,8 @@ find_symbol_value (symbol) return *XOBJFWD (valcontents)->objvar; case Lisp_Misc_Buffer_Objfwd: - return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset - + (char *)current_buffer); + return PER_BUFFER_VALUE (current_buffer, + XBUFFER_OBJFWD (valcontents)->offset); case Lisp_Misc_Kboard_Objfwd: return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset @@ -899,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; @@ -913,118 +1069,188 @@ 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); +} + +/* Return 1 if SYMBOL currently has a let-binding + which was made in the buffer that is now current. */ + +static int +let_shadows_buffer_binding_p (symbol) + Lisp_Object symbol; +{ + struct specbinding *p; + + for (p = specpdl_ptr - 1; p >= specpdl; p--) + 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 p >= specpdl; +} + +/* Store the value NEWVAL into SYMBOL. + If buffer-locality is an issue, BUF specifies which buffer to use. + (0 stands for the current buffer.) + + If BINDFLAG is zero, 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. */ + +Lisp_Object +set_internal (symbol, newval, buf, bindflag) register Lisp_Object symbol, newval; + struct buffer *buf; + int bindflag; { int voide = EQ (newval, Qunbound); - register Lisp_Object valcontents, tem1, current_alist_element; + register Lisp_Object valcontents, innercontents, tem1, current_alist_element; - CHECK_SYMBOL (symbol, 0); - if (NILP (symbol) || EQ (symbol, Qt)) + if (buf == 0) + buf = current_buffer; + + /* If restoring in a dead buffer, do nothing. */ + if (NILP (buf->name)) + return newval; + + 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)) { - register int idx = XBUFFER_OBJFWD (valcontents)->offset; - register int mask = XINT (*((Lisp_Object *) - (idx + (char *)&buffer_local_flags))); - if (mask > 0) - current_buffer->local_var_flags |= mask; + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); + if (idx > 0 + && !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 actually a pointer to a struct resembling a cons, - with contents something like: - (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE). - - BUFFER is the last buffer for which this symbol's value was - made up to date. - - CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's - local_var_alist, that being the element whose car is this - variable. Or it can be a pointer to the - (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not - have an element in its alist for this variable (that is, if - BUFFER sees the default value of this variable). - - If we want to examine or set the value and BUFFER is current, - we just examine or set REALVALUE. If BUFFER is not current, we - store the current REALVALUE value into CURRENT-ALIST-ELEMENT, - then find the appropriate alist element for the buffer now - current and set up CURRENT-ALIST-ELEMENT. Then we set - REALVALUE out of that element, and store into BUFFER. - - If we are setting the variable and the current buffer does - not have an alist entry for this variable, an alist entry is - created. - - Note that REALVALUE can be a forwarding pointer. Each time - it is examined or set, forwarding must be done. */ - - /* What value are we caching right now? */ - current_alist_element = - XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; + /* 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 + = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); /* If the current buffer is not the buffer whose binding is - currently cached, or if it's a Lisp_Buffer_Local_Value and - we're looking at the default value, the cache is invalid; we - need to write it out, and find the new CURRENT-ALIST-ELEMENT. */ - if ((current_buffer - != XBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car)) + 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 (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer) + || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer) + || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame + && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)) || (BUFFER_LOCAL_VALUEP (valcontents) - && EQ (XCONS (current_alist_element)->car, + && EQ (XCAR (current_alist_element), current_alist_element))) { - /* Write out the cached value for the old buffer; copy it - back to its alist element. This works if the current - buffer only sees the default value, too. */ + /* The currently loaded binding is not necessarily valid. + We need to unload it, and choose a new binding. */ + + /* Write out `realvalue' to the old loaded binding. */ Fsetcdr (current_alist_element, - do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car)); + do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); + + /* Find the new binding. */ + tem1 = Fassq (symbol, buf->local_var_alist); + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; - /* Find the new value for CURRENT-ALIST-ELEMENT. */ - tem1 = Fassq (symbol, current_buffer->local_var_alist); if (NILP (tem1)) { /* This buffer still sees the default value. */ /* If the variable is a Lisp_Some_Buffer_Local_Value, + or if this is `let' rather than `set', make CURRENT-ALIST-ELEMENT point to itself, - indicating that we're seeing the default value. */ - if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) - tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr; + indicating that we're seeing the default value. + Likewise if the variable has been let-bound + in the current buffer. */ + if (bindflag || SOME_BUFFER_LOCAL_VALUEP (valcontents) + || let_shadows_buffer_binding_p (symbol)) + { + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; - /* If it's a Lisp_Buffer_Local_Value, give this buffer a - new assoc for a local value and set - CURRENT-ALIST-ELEMENT to point to that. */ + if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) + tem1 = Fassq (symbol, + XFRAME (selected_frame)->param_alist); + + if (! NILP (tem1)) + XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1; + else + tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr; + } + /* If it's a Lisp_Buffer_Local_Value, being set not bound, + and we're not within a let that was made for this buffer, + create a new buffer-local binding for the variable. + That means, give this buffer a new assoc for a local value + and load that binding. */ else { tem1 = Fcons (symbol, Fcdr (current_alist_element)); - current_buffer->local_var_alist = - Fcons (tem1, current_buffer->local_var_alist); + buf->local_var_alist + = Fcons (tem1, buf->local_var_alist); } } - /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */ - XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car - = tem1; - /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */ - XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car, - current_buffer); + /* Record which binding is now loaded. */ + 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)->car; + 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; } @@ -1040,17 +1266,16 @@ 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. */ if (BUFFER_OBJFWDP (valcontents)) { - register int idx = XBUFFER_OBJFWD (valcontents)->offset; - - if (XINT (*(Lisp_Object *) (idx + (char *) &buffer_local_flags)) != 0) - return *(Lisp_Object *)(idx + (char *) &buffer_defaults); + int offset = XBUFFER_OBJFWD (valcontents)->offset; + if (PER_BUFFER_IDX (offset) != 0) + return PER_BUFFER_DEFAULT (offset); } /* Handle user-created local variables. */ @@ -1059,26 +1284,26 @@ default_value (symbol) { /* If var is set up for a buffer that lacks a local value for it, the current value is nominally the default value. - But the current value slot may be more up to date, since + But the `realvalue' slot may be more up to date, since ordinary setq stores just that slot. So use that. */ Lisp_Object current_alist_element, alist_element_car; current_alist_element - = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; - alist_element_car = XCONS (current_alist_element)->car; + = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); + alist_element_car = XCAR (current_alist_element); if (EQ (alist_element_car, current_alist_element)) - return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car); + return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue); else - return XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr; + return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); } /* For other variables, get the current value. */ return do_symval_forwarding (valcontents); } 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; @@ -1088,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; @@ -1104,33 +1329,36 @@ 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 variables. */ if (BUFFER_OBJFWDP (valcontents)) { - register int idx = XBUFFER_OBJFWD (valcontents)->offset; - register struct buffer *b; - register int mask = XINT (*((Lisp_Object *) - (idx + (char *)&buffer_local_flags))); + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); + + PER_BUFFER_DEFAULT (offset) = value; - if (mask > 0) + /* If this variable is not always local in all buffers, + set it in the buffers that don't nominally have a local value. */ + if (idx > 0) { - *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value; + struct buffer *b; + for (b = all_buffers; b; b = b->next) - if (!(b->local_var_flags & mask)) - *(Lisp_Object *)(idx + (char *) b) = value; + if (!PER_BUFFER_VALUE_P (b, idx)) + PER_BUFFER_VALUE (b, offset) = value; } return value; } @@ -1139,33 +1367,35 @@ for this variable.") && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) return Fset (symbol, value); - /* Store new value into the DEFAULT-VALUE slot */ - XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr = value; + /* Store new value into the DEFAULT-VALUE slot. */ + XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value); - /* If that slot is current, we must set the REALVALUE slot too */ + /* If the default binding is now loaded, set the REALVALUE slot too. */ current_alist_element - = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; + = 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)->car, - 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; @@ -1194,22 +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 have a separate value for each buffer.\n\ -At any time, the value for the current buffer is in effect.\n\ -There is also a default value which is seen in any buffer which has not yet\n\ -set its own value.\n\ -Using `set' or `setq' to set the variable causes it to have a separate value\n\ -for the current buffer if it was previously using the default value.\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); @@ -1217,42 +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)); - XCONS (tem)->car = tem; + XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value; - XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Fcurrent_buffer (), tem); - XSYMBOL (variable)->value = newval; + 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; + 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\ -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); @@ -1265,19 +1507,24 @@ Use `make-local-hook' instead.") Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound)); return variable; } - /* Make sure symbol is set up to hold per-buffer values */ + /* Make sure symbol is set up to hold per-buffer values. */ if (!SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object newval; tem = Fcons (Qnil, do_symval_forwarding (valcontents)); - XCONS (tem)->car = tem; + XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value; - XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Qnil, tem); - XSYMBOL (variable)->value = newval; + 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; + SET_SYMBOL_VALUE (variable, newval);; } - /* Make sure this buffer has its own value of symbol */ + /* Make sure this buffer has its own value of symbol. */ tem = Fassq (variable, current_buffer->local_var_alist); if (NILP (tem)) { @@ -1287,57 +1534,57 @@ Use `make-local-hook' instead.") find_symbol_value (variable); current_buffer->local_var_alist - = Fcons (Fcons (variable, XCONS (XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->cdr)->cdr)->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; - force it to look once again for this buffer's value */ + force it to look once again for this buffer's value. */ { Lisp_Object *pvalbuf; - valcontents = XSYMBOL (variable)->value; + valcontents = SYMBOL_VALUE (variable); - pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; + pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (current_buffer == XBUFFER (*pvalbuf)) *pvalbuf = Qnil; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; } } - /* If the symbol forwards into a C variable, then swap in the - variable for this buffer immediately. If C code modifies the - variable before we swap in, then that new value will clobber the - default value the next time we swap. */ - valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->car; + /* If the symbol forwards into a C variable, then load the binding + 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 (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)) { - register int idx = XBUFFER_OBJFWD (valcontents)->offset; - register int mask = XINT (*((Lisp_Object*) - (idx + (char *)&buffer_local_flags))); + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); - if (mask > 0) + if (idx > 0) { - *(Lisp_Object *)(idx + (char *) current_buffer) - = *(Lisp_Object *)(idx + (char *) &buffer_defaults); - current_buffer->local_var_flags &= ~mask; + SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); + PER_BUFFER_VALUE (current_buffer, offset) + = PER_BUFFER_DEFAULT (offset); } return variable; } @@ -1346,23 +1593,24 @@ From now on the default value will apply in this buffer.") && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) return variable; - /* Get rid of this buffer's alist element, if any */ + /* Get rid of this buffer's alist element, if any. */ tem = Fassq (variable, current_buffer->local_var_alist); if (!NILP (tem)) current_buffer->local_var_alist = Fdelq (tem, current_buffer->local_var_alist); - /* If the symbol is set up for the current buffer, recompute its - value. We have to do it now, or else forwarded objects won't - work right. */ + /* If the symbol is set up with the current buffer's binding + loaded, recompute its value. We have to do it now, or else + forwarded objects won't work right. */ { Lisp_Object *pvalbuf; - valcontents = XSYMBOL (variable)->value; - pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; + valcontents = SYMBOL_VALUE (variable); + pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (current_buffer == XBUFFER (*pvalbuf)) { *pvalbuf = Qnil; + XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; find_symbol_value (variable); } } @@ -1370,11 +1618,58 @@ From now on the default value will apply in this buffer.") return variable; } +/* 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: ", + 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); + + 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); + + if (BUFFER_LOCAL_VALUEP (valcontents) + || SOME_BUFFER_LOCAL_VALUEP (valcontents)) + { + XBUFFER_LOCAL_VALUE (valcontents)->check_frame = 1; + return variable; + } + + if (EQ (valcontents, Qunbound)) + SET_SYMBOL_VALUE (variable, Qnil); + tem = Fcons (Qnil, Fsymbol_value (variable)); + XSETCAR (tem, tem); + newval = allocate_misc (); + XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_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; + 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; @@ -1384,39 +1679,41 @@ 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; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) + + variable = indirect_variable (variable); + for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) { - elt = XCONS (tail)->car; - if (EQ (variable, XCONS (elt)->car)) + elt = XCAR (tail); + if (EQ (variable, XCAR (elt))) return Qt; } } if (BUFFER_OBJFWDP (valcontents)) { int offset = XBUFFER_OBJFWD (valcontents)->offset; - int mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); - if (mask == -1 || (buf->local_var_flags & mask)) + int idx = PER_BUFFER_IDX (offset); + if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) return Qt; } return Qnil; } 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; @@ -1426,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)) @@ -1443,10 +1740,10 @@ BUFFER defaults to the current buffer.") if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object tail, elt; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) { - elt = XCONS (tail)->car; - if (EQ (variable, XCONS (elt)->car)) + elt = XCAR (tail); + if (EQ (variable, XCAR (elt))) return Qt; } } @@ -1489,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; @@ -1511,24 +1808,30 @@ 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)) { - Lisp_Object val; + int c, idxval_byte; + if (idxval < 0 || idxval >= XSTRING (array)->size) args_out_of_range (array, idx); - XSETFASTINT (val, (unsigned char) XSTRING (array)->data[idxval]); - return val; + if (! STRING_MULTIBYTE (array)) + return make_number ((unsigned char) XSTRING (array)->data[idxval]); + idxval_byte = string_char_to_byte (array, idxval); + + c = STRING_CHAR (&XSTRING (array)->data[idxval_byte], + STRING_BYTES (XSTRING (array)) - idxval_byte); + return make_number (c); } else if (BOOL_VECTOR_P (array)) { @@ -1544,63 +1847,79 @@ or a byte-code object. IDX starts at 0.") { Lisp_Object val; + val = Qnil; + if (idxval < 0) args_out_of_range (array, idx); -#if 1 - if ((unsigned) idxval >= CHAR_TABLE_ORDINARY_SLOTS) - args_out_of_range (array, idx); - return val = XCHAR_TABLE (array)->contents[idxval]; -#else /* 0 */ - if ((unsigned) idxval < CHAR_TABLE_ORDINARY_SLOTS) - val = XCHAR_TABLE (array)->data[idxval]; - else + if (idxval < CHAR_TABLE_ORDINARY_SLOTS) { - int charset; - unsigned char c1, c2; - Lisp_Object val, temp; - - BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2); - - try_parent_char_table: - val = XCHAR_TABLE (array)->contents[charset]; - if (c1 == 0 || !CHAR_TABLE_P (val)) - return val; - - temp = XCHAR_TABLE (val)->contents[c1]; - if (NILP (temp)) - val = XCHAR_TABLE (val)->defalt; - else - val = temp; - - if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent)) + /* For ASCII and 8-bit European characters, the element is + stored in the top table. */ + val = XCHAR_TABLE (array)->contents[idxval]; + if (NILP (val)) + val = XCHAR_TABLE (array)->defalt; + while (NILP (val)) /* Follow parents until we find some value. */ { array = XCHAR_TABLE (array)->parent; - goto try_parent_char_table; - + if (NILP (array)) + return Qnil; + val = XCHAR_TABLE (array)->contents[idxval]; + if (NILP (val)) + val = XCHAR_TABLE (array)->defalt; } + return val; + } + else + { + int code[4], i; + Lisp_Object sub_table; - if (c2 == 0 || !CHAR_TABLE_P (val)) - return val; + SPLIT_CHAR (idxval, code[0], code[1], code[2]); + if (code[1] < 32) code[1] = -1; + else if (code[2] < 32) code[2] = -1; - temp = XCHAR_TABLE (val)->contents[c2]; - if (NILP (temp)) - val = XCHAR_TABLE (val)->defalt; - else - val = temp; + /* Here, the possible range of CODE[0] (== charset ID) is + 128..MAX_CHARSET. Since the top level char table contains + data for multibyte characters after 256th element, we must + increment CODE[0] by 128 to get a correct index. */ + code[0] += 128; + code[3] = -1; /* anchor */ - if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent)) + try_parent_char_table: + sub_table = array; + for (i = 0; code[i] >= 0; i++) + { + val = XCHAR_TABLE (sub_table)->contents[code[i]]; + if (SUB_CHAR_TABLE_P (val)) + sub_table = val; + else + { + if (NILP (val)) + val = XCHAR_TABLE (sub_table)->defalt; + if (NILP (val)) + { + array = XCHAR_TABLE (array)->parent; + if (!NILP (array)) + goto try_parent_char_table; + } + return val; + } + } + /* Here, VAL is a sub char table. We try the default value + and parent. */ + val = XCHAR_TABLE (val)->defalt; + if (NILP (val)) { array = XCHAR_TABLE (array)->parent; - goto try_parent_char_table; + if (!NILP (array)) + goto try_parent_char_table; } - return val; } -#endif /* 0 */ } else { - int size; + int size = 0; if (VECTORP (array)) size = XVECTOR (array)->size; else if (COMPILEDP (array)) @@ -1614,16 +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 or a string. 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)) @@ -1653,52 +1978,122 @@ ARRAY may be a vector or a string. IDX starts at 0.") } else if (CHAR_TABLE_P (array)) { - Lisp_Object val; - if (idxval < 0) args_out_of_range (array, idx); -#if 1 - if (idxval >= CHAR_TABLE_ORDINARY_SLOTS) - args_out_of_range (array, idx); - XCHAR_TABLE (array)->contents[idxval] = newelt; - return newelt; -#else /* 0 */ if (idxval < CHAR_TABLE_ORDINARY_SLOTS) - val = XCHAR_TABLE (array)->contents[idxval]; + XCHAR_TABLE (array)->contents[idxval] = newelt; else { - int charset; - unsigned char c1, c2; - Lisp_Object val, val2; + int code[4], i; + Lisp_Object val; - BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2); + SPLIT_CHAR (idxval, code[0], code[1], code[2]); + if (code[1] < 32) code[1] = -1; + else if (code[2] < 32) code[2] = -1; - if (c1 == 0) - return XCHAR_TABLE (array)->contents[charset] = newelt; + /* See the comment of the corresponding part in Faref. */ + code[0] += 128; + code[3] = -1; /* anchor */ + for (i = 0; code[i + 1] >= 0; i++) + { + val = XCHAR_TABLE (array)->contents[code[i]]; + if (SUB_CHAR_TABLE_P (val)) + array = val; + else + { + Lisp_Object temp; - val = XCHAR_TABLE (array)->contents[charset]; - if (!CHAR_TABLE_P (val)) - XCHAR_TABLE (array)->contents[charset] - = val = Fmake_char_table (Qnil); + /* VAL is a leaf. Create a sub char table with the + default value VAL or XCHAR_TABLE (array)->defalt + and look into it. */ - if (c2 == 0) - return XCHAR_TABLE (val)->contents[c1] = newelt; + temp = make_sub_char_table (NILP (val) + ? XCHAR_TABLE (array)->defalt + : val); + XCHAR_TABLE (array)->contents[code[i]] = temp; + array = temp; + } + } + XCHAR_TABLE (array)->contents[code[i]] = newelt; + } + } + else if (STRING_MULTIBYTE (array)) + { + int idxval_byte, prev_bytes, new_bytes; + unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - val2 = XCHAR_TABLE (val)->contents[c2]; - if (!CHAR_TABLE_P (val2)) - XCHAR_TABLE (val)->contents[charset] - = val2 = Fmake_char_table (Qnil); + if (idxval < 0 || idxval >= XSTRING (array)->size) + args_out_of_range (array, idx); + CHECK_NUMBER (newelt); - return XCHAR_TABLE (val2)->contents[c2] = newelt; + idxval_byte = string_char_to_byte (array, idxval); + 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 (); } -#endif /* 0 */ + 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; @@ -1713,23 +2108,18 @@ arithcompare (num1, num2, comparison) Lisp_Object num1, num2; enum comparison comparison; { - double f1, f2; + double f1 = 0, f2 = 0; int floatp = 0; -#ifdef LISP_FLOAT_TYPE - 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)) { floatp = 1; - f1 = (FLOATP (num1)) ? XFLOAT (num1)->data : XINT (num1); - f2 = (FLOATP (num2)) ? XFLOAT (num2)->data : XINT (num2); + f1 = (FLOATP (num1)) ? XFLOAT_DATA (num1) : XINT (num1); + f2 = (FLOATP (num2)) ? XFLOAT_DATA (num2) : XINT (num2); } -#else - CHECK_NUMBER_COERCE_MARKER (num1, 0); - CHECK_NUMBER_COERCE_MARKER (num2, 0); -#endif /* LISP_FLOAT_TYPE */ switch (comparison) { @@ -1769,71 +2159,68 @@ arithcompare (num1, num2, comparison) } DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, - "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, - "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, - "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, - "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, - "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, - "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, "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; { -#ifdef LISP_FLOAT_TYPE - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { - if (XFLOAT(number)->data == 0.0) + if (XFLOAT_DATA (number) == 0.0) return Qt; return Qnil; } -#else - CHECK_NUMBER (number, 0); -#endif /* LISP_FLOAT_TYPE */ if (!XINT (number)) return Qt; @@ -1862,82 +2249,141 @@ cons_to_long (c) Lisp_Object top, bot; if (INTEGERP (c)) return XINT (c); - top = XCONS (c)->car; - bot = XCONS (c)->cdr; + top = XCAR (c); + bot = XCDR (c); if (CONSP (bot)) - bot = XCONS (bot)->car; + bot = XCAR (bot); return ((XINT (top) << 16) | XINT (bot)); } 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]; -#ifndef LISP_FLOAT_TYPE - CHECK_NUMBER (number, 0); -#else - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { char pigbuf[350]; /* see comments in float_to_string */ - float_to_string (pigbuf, XFLOAT(number)->data); + float_to_string (pigbuf, XFLOAT_DATA (number)); return build_string (pigbuf); } -#endif /* LISP_FLOAT_TYPE */ if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buffer, "%d", XINT (number)); else if (sizeof (long) == sizeof (EMACS_INT)) - sprintf (buffer, "%ld", XINT (number)); + sprintf (buffer, "%ld", (long) XINT (number)); else abort (); return build_string (buffer); } -DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 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.") - (string) - register Lisp_Object string; +INLINE static int +digit_to_number (character, base) + int character, base; { - Lisp_Object value; - unsigned char *p; + int digit; - CHECK_STRING (string, 0); + if (character >= '0' && character <= '9') + digit = character - '0'; + else if (character >= 'a' && character <= 'z') + digit = character - 'a' + 10; + else if (character >= 'A' && character <= 'Z') + digit = character - 'A' + 10; + else + return -1; - p = XSTRING (string)->data; + if (digit >= base) + return -1; + else + return digit; +} + +DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, + 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; + register int b; + int sign = 1; + Lisp_Object val; + + CHECK_STRING (string); + + if (NILP (base)) + b = 10; + else + { + CHECK_NUMBER (base); + b = XINT (base); + if (b < 2 || b > 16) + Fsignal (Qargs_out_of_range, Fcons (base, Qnil)); + } /* Skip any whitespace at the front of the number. Some versions of atoi do this anyway, so we might as well make Emacs lisp consistent. */ + p = XSTRING (string)->data; while (*p == ' ' || *p == '\t') p++; -#ifdef LISP_FLOAT_TYPE - if (isfloat_string (p)) - return make_float (atof (p)); -#endif /* LISP_FLOAT_TYPE */ - - if (sizeof (int) == sizeof (EMACS_INT)) - XSETINT (value, atoi (p)); - else if (sizeof (long) == sizeof (EMACS_INT)) - XSETINT (value, atol (p)); + if (*p == '-') + { + sign = -1; + p++; + } + else if (*p == '+') + p++; + + if (isfloat_string (p) && b == 10) + val = make_float (sign * atof (p)); else - abort (); - return value; + { + double v = 0; + + while (1) + { + int digit = digit_to_number (*p++, b); + if (digit < 0) + break; + v = v * b + digit; + } + + val = make_fixnum_or_float (sign * v); + } + + return val; } + 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 arith_driver (code, nargs, args) @@ -1947,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)) @@ -1956,38 +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_... */ -#ifdef LISP_FLOAT_TYPE - 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)); -#else - CHECK_NUMBER_COERCE_MARKER (val, argnum); -#endif /* LISP_FLOAT_TYPE */ - 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: - if (!argnum && nargs != 1) - next = - next; - accum -= next; + 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) @@ -1995,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; } } @@ -2007,12 +2470,10 @@ arith_driver (code, nargs, args) return val; } -#ifdef LISP_FLOAT_TYPE - #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; @@ -2026,11 +2487,11 @@ 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)) { - next = XFLOAT (val)->data; + next = XFLOAT_DATA (val); } else { @@ -2043,9 +2504,7 @@ float_arith_driver (accum, argnum, code, nargs, args) accum += next; break; case Asub: - if (!argnum && nargs != 1) - next = - next; - accum -= next; + accum = argnum ? accum - next : nargs == 1 ? - next : next; break; case Amult: accum *= next; @@ -2055,7 +2514,7 @@ float_arith_driver (accum, argnum, code, nargs, args) accum = next; else { - if (next == 0) + if (! IEEE_FLOATING_POINT && next == 0) Fsignal (Qarith_error, Qnil); accum /= next; } @@ -2077,11 +2536,12 @@ float_arith_driver (accum, argnum, code, nargs, args) return make_float (accum); } -#endif /* LISP_FLOAT_TYPE */ + 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; { @@ -2089,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; { @@ -2100,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; { @@ -2109,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; { @@ -2119,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); @@ -2141,45 +2604,39 @@ double fmod (f1, f2) double f1, f2; { + double r = f1; + if (f2 < 0.0) f2 = -f2; - return (f1 - f2 * floor (f1/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, - "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; -#ifdef LISP_FLOAT_TYPE - 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)) - { - double f1, f2; - - f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x); - f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y); - if (f2 == 0) - Fsignal (Qarith_error, Qnil); - - f1 = fmod (f1, f2); - /* If the "remainder" comes out with the wrong sign, fix it. */ - if (f2 < 0 ? f1 > 0 : f1 < 0) - f1 += f2; - return (make_float (f1)); - } -#else /* not LISP_FLOAT_TYPE */ - CHECK_NUMBER_COERCE_MARKER (x, 0); - CHECK_NUMBER_COERCE_MARKER (y, 1); -#endif /* not LISP_FLOAT_TYPE */ + return fmod_float (x, y); i1 = XINT (x); i2 = XINT (y); @@ -2198,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; { @@ -2208,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; { @@ -2218,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; { @@ -2228,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; { @@ -2238,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; { @@ -2248,87 +2710,87 @@ 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) > 0) + if (XINT (count) >= BITS_PER_EMACS_INT) + XSETINT (val, 0); + else if (XINT (count) > 0) XSETINT (val, XINT (value) << XFASTINT (count)); + else if (XINT (count) <= -BITS_PER_EMACS_INT) + XSETINT (val, XINT (value) < 0 ? -1 : 0); else XSETINT (val, XINT (value) >> -XINT (count)); return val; } 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) > 0) + if (XINT (count) >= BITS_PER_EMACS_INT) + XSETINT (val, 0); + else if (XINT (count) > 0) XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count)); + else if (XINT (count) <= -BITS_PER_EMACS_INT) + XSETINT (val, 0); else XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count)); return val; } 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; { -#ifdef LISP_FLOAT_TYPE - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) - return (make_float (1.0 + XFLOAT (number)->data)); -#else - CHECK_NUMBER_COERCE_MARKER (number, 0); -#endif /* LISP_FLOAT_TYPE */ + return (make_float (1.0 + XFLOAT_DATA (number))); XSETINT (number, XINT (number) + 1); return number; } 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; { -#ifdef LISP_FLOAT_TYPE - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) - return (make_float (-1.0 + XFLOAT (number)->data)); -#else - CHECK_NUMBER_COERCE_MARKER (number, 0); -#endif /* LISP_FLOAT_TYPE */ + return (make_float (-1.0 + XFLOAT_DATA (number))); XSETINT (number, XINT (number) - 1); return number; } 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; } @@ -2351,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"); @@ -2363,11 +2826,13 @@ syms_of_data () Qbeginning_of_buffer = intern ("beginning-of-buffer"); Qend_of_buffer = intern ("end-of-buffer"); Qbuffer_read_only = intern ("buffer-read-only"); + Qtext_read_only = intern ("text-read-only"); Qmark_inactive = intern ("mark-inactive"); Qlistp = intern ("listp"); Qconsp = intern ("consp"); Qsymbolp = intern ("symbolp"); + Qkeywordp = intern ("keywordp"); Qintegerp = intern ("integerp"); Qnatnump = intern ("natnump"); Qwholenump = intern ("wholenump"); @@ -2383,20 +2848,22 @@ syms_of_data () Qboundp = intern ("boundp"); Qfboundp = intern ("fboundp"); -#ifdef LISP_FLOAT_TYPE Qfloatp = intern ("floatp"); Qnumberp = intern ("numberp"); Qnumber_or_marker_p = intern ("number-or-marker-p"); -#endif /* LISP_FLOAT_TYPE */ Qchar_table_p = intern ("char-table-p"); Qvector_or_char_table_p = intern ("vector-or-char-table-p"); + Qsubrp = intern ("subrp"); + Qunevalled = intern ("unevalled"); + Qmany = intern ("many"); + Qcdr = intern ("cdr"); /* Handle automatic advice activation */ Qad_advice_info = intern ("ad-advice-info"); - Qad_activate = intern ("ad-activate"); + Qad_activate_internal = intern ("ad-activate-internal"); error_tail = Fcons (Qerror, Qnil); @@ -2432,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, @@ -2488,7 +2967,11 @@ syms_of_data () Fput (Qbuffer_read_only, Qerror_message, build_string ("Buffer is read-only")); -#ifdef LISP_FLOAT_TYPE + Fput (Qtext_read_only, Qerror_conditions, + Fcons (Qtext_read_only, error_tail)); + Fput (Qtext_read_only, Qerror_message, + build_string ("Text is read-only")); + Qrange_error = intern ("range-error"); Qdomain_error = intern ("domain-error"); Qsingularity_error = intern ("singularity-error"); @@ -2525,7 +3008,6 @@ syms_of_data () staticpro (&Qsingularity_error); staticpro (&Qoverflow_error); staticpro (&Qunderflow_error); -#endif /* LISP_FLOAT_TYPE */ staticpro (&Qnil); staticpro (&Qt); @@ -2554,11 +3036,13 @@ syms_of_data () staticpro (&Qbeginning_of_buffer); staticpro (&Qend_of_buffer); staticpro (&Qbuffer_read_only); + staticpro (&Qtext_read_only); staticpro (&Qmark_inactive); staticpro (&Qlistp); staticpro (&Qconsp); staticpro (&Qsymbolp); + staticpro (&Qkeywordp); staticpro (&Qintegerp); staticpro (&Qnatnump); staticpro (&Qwholenump); @@ -2571,19 +3055,20 @@ syms_of_data () staticpro (&Qmarkerp); staticpro (&Qbuffer_or_string_p); staticpro (&Qinteger_or_marker_p); -#ifdef LISP_FLOAT_TYPE staticpro (&Qfloatp); staticpro (&Qnumberp); staticpro (&Qnumber_or_marker_p); -#endif /* LISP_FLOAT_TYPE */ staticpro (&Qchar_table_p); staticpro (&Qvector_or_char_table_p); + staticpro (&Qsubrp); + staticpro (&Qmany); + staticpro (&Qunevalled); staticpro (&Qboundp); staticpro (&Qfboundp); staticpro (&Qcdr); staticpro (&Qad_advice_info); - staticpro (&Qad_activate); + staticpro (&Qad_activate_internal); /* Types that type-of returns. */ Qinteger = intern ("integer"); @@ -2603,6 +3088,7 @@ syms_of_data () Qvector = intern ("vector"); Qchar_table = intern ("char-table"); Qbool_vector = intern ("bool-vector"); + Qhash_table = intern ("hash-table"); staticpro (&Qinteger); staticpro (&Qsymbol); @@ -2621,7 +3107,10 @@ syms_of_data () staticpro (&Qvector); staticpro (&Qchar_table); staticpro (&Qbool_vector); + staticpro (&Qhash_table); + defsubr (&Sindirect_variable); + defsubr (&Ssubr_interactive_form); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -2633,12 +3122,12 @@ syms_of_data () defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); -#ifdef LISP_FLOAT_TYPE defsubr (&Sfloatp); -#endif /* LISP_FLOAT_TYPE */ defsubr (&Snatnump); defsubr (&Ssymbolp); + defsubr (&Skeywordp); defsubr (&Sstringp); + defsubr (&Smultibyte_string_p); defsubr (&Svectorp); defsubr (&Schar_table_p); defsubr (&Svector_or_char_table_p); @@ -2666,7 +3155,6 @@ syms_of_data () defsubr (&Sfboundp); defsubr (&Sfset); defsubr (&Sdefalias); - defsubr (&Sdefine_function); defsubr (&Ssetplist); defsubr (&Ssymbol_value); defsubr (&Sset); @@ -2677,6 +3165,7 @@ syms_of_data () defsubr (&Smake_variable_buffer_local); defsubr (&Smake_local_variable); defsubr (&Skill_local_variable); + defsubr (&Smake_variable_frame_local); defsubr (&Slocal_variable_p); defsubr (&Slocal_variable_if_set_p); defsubr (&Saref); @@ -2706,8 +3195,17 @@ syms_of_data () defsubr (&Sadd1); defsubr (&Ssub1); defsubr (&Slognot); + 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 @@ -2732,6 +3230,7 @@ arith_error (signo) Fsignal (Qarith_error, Qnil); } +void init_data () { /* Don't do this if just dumping out.