X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f9d1e467d22c63f8561d24894c12f41dc1cf4e2c..826256dd2b72d9046df706235c8424c2344d7430:/src/data.c diff --git a/src/data.c b/src/data.c index cf916141d3..c0c797da26 100644 --- a/src/data.c +++ b/src/data.c @@ -1,6 +1,6 @@ /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. - Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -71,6 +71,7 @@ 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; @@ -87,7 +88,8 @@ Lisp_Object Qoverflow_error, Qunderflow_error; Lisp_Object Qfloatp; Lisp_Object Qnumberp, Qnumber_or_marker_p; -static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; +Lisp_Object Qinteger; +static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; @@ -96,7 +98,7 @@ static Lisp_Object Qsubrp, Qmany, Qunevalled; static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); -int most_positive_fixnum, most_negative_fixnum; +Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum; void @@ -114,15 +116,6 @@ wrong_type_argument (predicate, value) register Lisp_Object tem; do { - if (!EQ (Vmocklisp_arguments, Qt)) - { - if (STRINGP (value) && - (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p))) - return Fstring_to_number (value, Qnil); - if (INTEGERP (value) && EQ (predicate, Qstringp)) - return Fnumber_to_string (value); - } - /* If VALUE is not even a valid Lisp object, abort here where we can get a backtrace showing where it came from. */ if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) @@ -320,7 +313,7 @@ interned in the initial obarray. */) Lisp_Object object; { if (SYMBOLP (object) - && XSYMBOL (object)->name->data[0] == ':' + && SREF (SYMBOL_NAME (object), 0) == ':' && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object)) return Qt; return Qnil; @@ -616,7 +609,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, register Lisp_Object symbol; { Lisp_Object valcontents; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); valcontents = SYMBOL_VALUE (symbol); @@ -632,16 +625,17 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, (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, - doc: /* Make SYMBOL's value be void. */) + doc: /* Make SYMBOL's value be void. +Return SYMBOL. */) (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); if (XSYMBOL (symbol)->constant) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); Fset (symbol, Qunbound); @@ -649,11 +643,12 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, } DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, - doc: /* Make SYMBOL's function definition be void. */) + doc: /* Make SYMBOL's function definition be void. +Return SYMBOL. */) (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; @@ -665,7 +660,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, (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; @@ -676,7 +671,7 @@ DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, (symbol) register Lisp_Object symbol; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); return XSYMBOL (symbol)->plist; } @@ -687,8 +682,8 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, { register Lisp_Object name; - CHECK_SYMBOL (symbol, 0); - XSETSTRING (name, XSYMBOL (symbol)->name); + CHECK_SYMBOL (symbol); + name = SYMBOL_NAME (symbol); return name; } @@ -697,7 +692,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, (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)) @@ -713,23 +708,33 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, return definition; } -DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, +extern Lisp_Object Qfunction_documentation; + +DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, 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; -{ +Associates the function with the current load file, if any. +The optional third argument DOCSTRING specifies the documentation string +for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string +determined by DEFINITION. */) + (symbol, definition, docstring) + register Lisp_Object symbol, definition, docstring; +{ + if (CONSP (XSYMBOL (symbol)->function) + && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) + LOADHIST_ATTACH (Fcons (Qt, symbol)); definition = Ffset (symbol, definition); - LOADHIST_ATTACH (symbol); + LOADHIST_ATTACH (Fcons (Qdefun, symbol)); + if (!NILP (docstring)) + Fput (symbol, Qfunction_documentation, docstring); return definition; } DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, - doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. */) + doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */) (symbol, newplist) register Lisp_Object symbol, newplist; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); XSYMBOL (symbol)->plist = newplist; return newplist; } @@ -756,17 +761,52 @@ function with `&rest' args, or `unevalled' for a special form. */) return Fcons (make_number (minargs), make_number (maxargs)); } -DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, - doc: /* Return the interactive form of SUBR or nil if none. -SUBR must be a built-in function. Value, if non-nil, is a list -\(interactive SPEC). */) +DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, + doc: /* Return name of subroutine SUBR. +SUBR must be a built-in function. */) (subr) Lisp_Object subr; { + const char *name; if (!SUBRP (subr)) wrong_type_argument (Qsubrp, subr); - if (XSUBR (subr)->prompt) - return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); + name = XSUBR (subr)->symbol_name; + return make_string (name, strlen (name)); +} + +DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, + doc: /* Return the interactive form of CMD or nil if none. +If CMD is not a command, the return value is nil. +Value, if non-nil, is a list \(interactive SPEC). */) + (cmd) + Lisp_Object cmd; +{ + Lisp_Object fun = indirect_function (cmd); + + if (SUBRP (fun)) + { + if (XSUBR (fun)->prompt) + return list2 (Qinteractive, build_string (XSUBR (fun)->prompt)); + } + else if (COMPILEDP (fun)) + { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) + return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + } + else if (CONSP (fun)) + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (XCDR (fun))); + else if (EQ (funcar, Qautoload)) + { + struct gcpro gcpro1; + GCPRO1 (cmd); + do_autoload (fun, cmd); + UNGCPRO; + return Finteractive_form (cmd); + } + } return Qnil; } @@ -792,7 +832,7 @@ indirect_variable (symbol) hare = XSYMBOL (hare)->value; if (!XSYMBOL (hare)->indirect_variable) break; - + hare = XSYMBOL (hare)->value; tortoise = XSYMBOL (tortoise)->value; @@ -874,11 +914,11 @@ store_symval_forwarding (symbol, valcontents, newval, buf) 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'", - XSYMBOL (symbol)->name->data); + SDATA (SYMBOL_NAME (symbol))); break; case Lisp_Misc_Boolfwd: @@ -887,6 +927,36 @@ store_symval_forwarding (symbol, valcontents, newval, buf) case Lisp_Misc_Objfwd: *XOBJFWD (valcontents)->objvar = newval; + + /* If this variable is a default for something stored + in the buffer itself, such as default-fill-column, + find the buffers that don't have local values for it + and update them. */ + if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults + && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1)) + { + int offset = ((char *) XOBJFWD (valcontents)->objvar + - (char *) &buffer_defaults); + int idx = PER_BUFFER_IDX (offset); + + Lisp_Object tail; + + if (idx <= 0) + break; + + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object buf; + struct buffer *b; + + buf = Fcdr (XCAR (tail)); + if (!BUFFERP (buf)) continue; + b = XBUFFER (buf); + + if (! PER_BUFFER_VALUE_P (b, idx)) + PER_BUFFER_VALUE (b, offset) = newval; + } + } break; case Lisp_Misc_Buffer_Objfwd: @@ -895,9 +965,6 @@ store_symval_forwarding (symbol, valcontents, newval, buf) Lisp_Object type; 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); @@ -940,7 +1007,7 @@ swap_in_global_binding (symbol) Lisp_Object symbol; { Lisp_Object valcontents, cdr; - + valcontents = SYMBOL_VALUE (symbol); if (!BUFFER_LOCAL_VALUEP (valcontents) && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) @@ -950,7 +1017,7 @@ swap_in_global_binding (symbol) /* 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); @@ -974,7 +1041,7 @@ swap_in_symval_forwarding (symbol, valcontents) Lisp_Object symbol, valcontents; { register Lisp_Object tem1; - + tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (NILP (tem1) @@ -984,7 +1051,7 @@ swap_in_symval_forwarding (symbol, valcontents) { if (XSYMBOL (symbol)->indirect_variable) symbol = indirect_variable (symbol); - + /* Unload the previously loaded binding. */ tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); Fsetcdr (tem1, @@ -1028,8 +1095,8 @@ find_symbol_value (symbol) { register Lisp_Object valcontents; register Lisp_Object val; - - CHECK_SYMBOL (symbol, 0); + + CHECK_SYMBOL (symbol); valcontents = SYMBOL_VALUE (symbol); if (BUFFER_LOCAL_VALUEP (valcontents) @@ -1092,7 +1159,7 @@ static int let_shadows_buffer_binding_p (symbol) Lisp_Object symbol; { - struct specbinding *p; + volatile struct specbinding *p; for (p = specpdl_ptr - 1; p >= specpdl; p--) if (p->func == NULL @@ -1134,14 +1201,14 @@ set_internal (symbol, newval, buf, bindflag) if (NILP (buf->name)) return newval; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); if (SYMBOL_CONSTANT_P (symbol) && (NILP (Fkeywordp (symbol)) || !EQ (newval, SYMBOL_VALUE (symbol)))) return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); innercontents = valcontents = SYMBOL_VALUE (symbol); - + if (BUFFER_OBJFWDP (valcontents)) { int offset = XBUFFER_OBJFWD (valcontents)->offset; @@ -1218,7 +1285,7 @@ set_internal (symbol, newval, buf, bindflag) and load that binding. */ else { - tem1 = Fcons (symbol, Fcdr (current_alist_element)); + tem1 = Fcons (symbol, XCDR (current_alist_element)); buf->local_var_alist = Fcons (tem1, buf->local_var_alist); } @@ -1275,7 +1342,7 @@ default_value (symbol) { register Lisp_Object valcontents; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); valcontents = SYMBOL_VALUE (symbol); /* For a built-in buffer-local variable, get the default value @@ -1338,7 +1405,7 @@ local bindings in certain buffers. */) } DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, - doc: /* Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated. + doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. The default value is seen in buffers that do not have their own values for this variable. */) (symbol, value) @@ -1346,7 +1413,7 @@ for this variable. */) { register Lisp_Object valcontents, current_alist_element, alist_element_buffer; - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); valcontents = SYMBOL_VALUE (symbol); /* Handle variables like case-fold-search that have special slots @@ -1364,7 +1431,7 @@ for this variable. */) if (idx > 0) { struct buffer *b; - + for (b = all_buffers; b; b = b->next) if (!PER_BUFFER_VALUE_P (b, idx)) PER_BUFFER_VALUE (b, offset) = value; @@ -1391,19 +1458,19 @@ for this variable. */) return value; } -DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, +DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0, 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. +VALUE is an expression: it is evaluated and its value returned. 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...]) */) + (setq-default VAR VALUE VAR VALUE...) +This sets each VAR's default value to the corresponding VALUE. +The VALUE for the Nth VAR can refer to the new default values +of previous VARs. +usage: (setq-default [VAR VALUE...]) */) (args) Lisp_Object args; { @@ -1420,9 +1487,9 @@ usage: (setq-default SYMBOL VALUE [SYMBOL VALUE...]) */) do { val = Feval (Fcar (Fcdr (args_left))); - symbol = Fcar (args_left); + symbol = XCAR (args_left); Fset_default (symbol, val); - args_left = Fcdr (Fcdr (args_left)); + args_left = Fcdr (XCDR (args_left)); } while (!NILP (args_left)); @@ -1440,7 +1507,10 @@ 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. +does not make the variable buffer-local. Return VARIABLE. + +In most cases it is better to use `make-local-variable', +which makes a variable local in just one buffer. The function `default-value' gets the default value and `set-default' sets it. */) (variable) @@ -1448,11 +1518,12 @@ The function `default-value' gets the default value and `set-default' sets it. { register Lisp_Object tem, valcontents, newval; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); + variable = indirect_variable (variable); 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); + error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) return variable; @@ -1484,7 +1555,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable, 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'. +Return VARIABLE. If the variable is already arranged to become local when set, this function causes a local value to exist for this buffer, @@ -1494,6 +1565,8 @@ This function returns VARIABLE, and therefore (set (make-local-variable 'VARIABLE) VALUE-EXP) works. +See also `make-variable-buffer-local'. + 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) @@ -1501,11 +1574,12 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) { register Lisp_Object tem, valcontents; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); + variable = indirect_variable (variable); 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); + error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) { @@ -1574,13 +1648,14 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_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. */) +From now on the default value will apply in this buffer. Return VARIABLE. */) (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); @@ -1613,10 +1688,11 @@ From now on the default value will apply in this buffer. */) loaded, recompute its value. We have to do it now, or else forwarded objects won't work right. */ { - Lisp_Object *pvalbuf; + Lisp_Object *pvalbuf, buf; valcontents = SYMBOL_VALUE (variable); pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; - if (current_buffer == XBUFFER (*pvalbuf)) + XSETBUFFER (buf, current_buffer); + if (EQ (buf, *pvalbuf)) { *pvalbuf = Qnil; XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; @@ -1634,21 +1710,22 @@ DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_f 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'. */) +A frame-local binding is actually 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. Return VARIABLE. +See `modify-frame-parameters' for how to set frame parameters. */) (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents, newval; - CHECK_SYMBOL (variable, 0); + CHECK_SYMBOL (variable); + variable = indirect_variable (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); + error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) @@ -1688,11 +1765,12 @@ 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); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); if (BUFFER_LOCAL_VALUEP (valcontents) @@ -1700,7 +1778,6 @@ BUFFER defaults to the current buffer. */) { Lisp_Object tail, elt; - variable = indirect_variable (variable); for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); @@ -1720,7 +1797,11 @@ BUFFER defaults to the current buffer. */) DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1, 2, 0, - doc: /* Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. + doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there. +More precisely, this means that setting the variable \(with `set' or`setq'), +while it does not have a `let'-style binding that was made in BUFFER, +will produce a buffer local binding. See Info node +`(elisp)Creating Buffer-Local'. BUFFER defaults to the current buffer. */) (variable, buffer) register Lisp_Object variable, buffer; @@ -1732,11 +1813,12 @@ 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); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); @@ -1758,6 +1840,41 @@ BUFFER defaults to the current buffer. */) } return Qnil; } + +DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus, + 1, 1, 0, + doc: /* Return a value indicating where VARIABLE's current binding comes from. +If the current binding is buffer-local, the value is the current buffer. +If the current binding is frame-local, the value is the selected frame. +If the current binding is global (the default), the value is nil. */) + (variable) + register Lisp_Object variable; +{ + Lisp_Object valcontents; + + CHECK_SYMBOL (variable); + variable = indirect_variable (variable); + + /* Make sure the current binding is actually swapped in. */ + find_symbol_value (variable); + + valcontents = XSYMBOL (variable)->value; + + if (BUFFER_LOCAL_VALUEP (valcontents) + || SOME_BUFFER_LOCAL_VALUEP (valcontents) + || BUFFER_OBJFWDP (valcontents)) + { + /* For a local variable, record both the symbol and which + buffer's or frame's value we are saving. */ + if (!NILP (Flocal_variable_p (variable, Qnil))) + return Fcurrent_buffer (); + else if (!BUFFER_OBJFWDP (valcontents) + && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) + return XBUFFER_LOCAL_VALUE (valcontents)->frame; + } + + return Qnil; +} /* Find the function at the end of a chain of symbol function indirections. */ @@ -1826,20 +1943,20 @@ or a byte-code object. IDX starts at 0. */) { register int idxval; - CHECK_NUMBER (idx, 1); + CHECK_NUMBER (idx); idxval = XINT (idx); if (STRINGP (array)) { int c, idxval_byte; - if (idxval < 0 || idxval >= XSTRING (array)->size) + if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); if (! STRING_MULTIBYTE (array)) - return make_number ((unsigned char) XSTRING (array)->data[idxval]); + return make_number ((unsigned char) SREF (array, idxval)); idxval_byte = string_char_to_byte (array, idxval); - c = STRING_CHAR (&XSTRING (array)->data[idxval_byte], - STRING_BYTES (XSTRING (array)) - idxval_byte); + c = STRING_CHAR (SDATA (array) + idxval_byte, + SBYTES (array) - idxval_byte); return make_number (c); } else if (BOOL_VECTOR_P (array)) @@ -1849,8 +1966,8 @@ or a byte-code object. IDX starts at 0. */) if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; - return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil); + val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; + return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil); } else if (CHAR_TABLE_P (array)) { @@ -1862,9 +1979,19 @@ or a byte-code object. IDX starts at 0. */) args_out_of_range (array, idx); if (idxval < CHAR_TABLE_ORDINARY_SLOTS) { + if (! SINGLE_BYTE_CHAR_P (idxval)) + args_out_of_range (array, idx); /* For ASCII and 8-bit European characters, the element is stored in the top table. */ val = XCHAR_TABLE (array)->contents[idxval]; + if (NILP (val)) + { + int default_slot + = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII + : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); + val = XCHAR_TABLE (array)->contents[default_slot]; + } if (NILP (val)) val = XCHAR_TABLE (array)->defalt; while (NILP (val)) /* Follow parents until we find some value. */ @@ -1882,6 +2009,7 @@ or a byte-code object. IDX starts at 0. */) { int code[4], i; Lisp_Object sub_table; + Lisp_Object current_default; SPLIT_CHAR (idxval, code[0], code[1], code[2]); if (code[1] < 32) code[1] = -1; @@ -1895,16 +2023,21 @@ or a byte-code object. IDX starts at 0. */) code[3] = -1; /* anchor */ try_parent_char_table: + current_default = XCHAR_TABLE (array)->defalt; 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; + { + sub_table = val; + if (! NILP (XCHAR_TABLE (sub_table)->defalt)) + current_default = XCHAR_TABLE (sub_table)->defalt; + } else { if (NILP (val)) - val = XCHAR_TABLE (sub_table)->defalt; + val = current_default; if (NILP (val)) { array = XCHAR_TABLE (array)->parent; @@ -1914,9 +2047,12 @@ or a byte-code object. IDX starts at 0. */) return val; } } - /* Here, VAL is a sub char table. We try the default value - and parent. */ - val = XCHAR_TABLE (val)->defalt; + /* Reaching here means IDXVAL is a generic character in + which each character or a group has independent value. + Essentially it's nonsense to get a value for such a + generic character, but for backward compatibility, we try + the default value and parent. */ + val = current_default; if (NILP (val)) { array = XCHAR_TABLE (array)->parent; @@ -1942,22 +2078,17 @@ 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, 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. */) +Return 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)) @@ -1977,20 +2108,24 @@ IDX starts at 0. */) if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; + val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; if (! NILP (newelt)) - val |= 1 << (idxval % BITS_PER_CHAR); + val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR); else - val &= ~(1 << (idxval % BITS_PER_CHAR)); - XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val; + val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)); + XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val; } else if (CHAR_TABLE_P (array)) { if (idxval < 0) args_out_of_range (array, idx); if (idxval < CHAR_TABLE_ORDINARY_SLOTS) - XCHAR_TABLE (array)->contents[idxval] = newelt; + { + if (! SINGLE_BYTE_CHAR_P (idxval)) + args_out_of_range (array, idx); + XCHAR_TABLE (array)->contents[idxval] = newelt; + } else { int code[4], i; @@ -2013,12 +2148,9 @@ IDX starts at 0. */) Lisp_Object temp; /* VAL is a leaf. Create a sub char table with the - default value VAL or XCHAR_TABLE (array)->defalt - and look into it. */ + initial value VAL and look into it. */ - temp = make_sub_char_table (NILP (val) - ? XCHAR_TABLE (array)->defalt - : val); + temp = make_sub_char_table (val); XCHAR_TABLE (array)->contents[code[i]] = temp; array = temp; } @@ -2028,36 +2160,35 @@ IDX starts at 0. */) } else if (STRING_MULTIBYTE (array)) { - int idxval_byte, prev_bytes, new_bytes; + int idxval_byte, prev_bytes, new_bytes, nbytes; unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - if (idxval < 0 || idxval >= XSTRING (array)->size) + if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); - CHECK_NUMBER (newelt, 2); + CHECK_NUMBER (newelt); + + nbytes = SBYTES (array); idxval_byte = string_char_to_byte (array, idxval); - p1 = &XSTRING (array)->data[idxval_byte]; + p1 = SDATA (array) + 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)); + int nchars = SCHARS (array); unsigned char *str; + USE_SAFE_ALLOCA; - str = (nbytes <= MAX_ALLOCA - ? (unsigned char *) alloca (nbytes) - : (unsigned char *) xmalloc (nbytes)); - bcopy (XSTRING (array)->data, str, nbytes); + SAFE_ALLOCA (str, unsigned char *, nbytes); + bcopy (SDATA (array), 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, SDATA (array), idxval_byte); + p1 = SDATA (array) + idxval_byte; bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, nbytes - (idxval_byte + prev_bytes)); - if (nbytes > MAX_ALLOCA) - xfree (str); + SAFE_FREE (); clear_string_char_byte_cache (); } while (new_bytes--) @@ -2065,42 +2196,40 @@ IDX starts at 0. */) } else { - if (idxval < 0 || idxval >= XSTRING (array)->size) + if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); - CHECK_NUMBER (newelt, 2); + CHECK_NUMBER (newelt); if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) - XSTRING (array)->data[idxval] = XINT (newelt); + SSET (array, 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; + unsigned char *origstr = SDATA (array), *str; int nchars, nbytes; + USE_SAFE_ALLOCA; - nchars = XSTRING (array)->size; + nchars = SCHARS (array); 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); + SAFE_ALLOCA (str, unsigned char *, nbytes); + copy_text (SDATA (array), 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; + bcopy (str, SDATA (array), idxval_byte); + p1 = SDATA (array) + 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); + SAFE_FREE (); clear_string_char_byte_cache (); } } @@ -2120,8 +2249,8 @@ arithcompare (num1, num2, comparison) double f1 = 0, f2 = 0; int floatp = 0; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); if (FLOATP (num1) || FLOATP (num2)) { @@ -2222,7 +2351,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { @@ -2242,7 +2371,7 @@ Lisp_Object long_to_cons (i) unsigned long i; { - unsigned int top = i >> 16; + unsigned long top = i >> 16; unsigned int bot = i & 0xFFFF; if (top == 0) return make_number (bot); @@ -2266,7 +2395,7 @@ cons_to_long (c) } DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, - doc: /* Convert NUMBER to a string by printing it in decimal. + doc: /* Return the decimal representation of NUMBER as a string. Uses a minus sign if negative. NUMBER may be an integer or a floating point number. */) (number) @@ -2274,7 +2403,7 @@ NUMBER may be an integer or a floating point number. */) { char buffer[VALBITS]; - CHECK_NUMBER_OR_FLOAT (number, 0); + CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) { @@ -2312,10 +2441,10 @@ digit_to_number (character, 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. + doc: /* Parse STRING as a decimal number and return the number. This parses both integers and floating point numbers. It ignores leading spaces and tabs. @@ -2330,13 +2459,13 @@ If the base used is not 10, floating point is not recognized. */) int sign = 1; Lisp_Object val; - CHECK_STRING (string, 0); + CHECK_STRING (string); if (NILP (base)) b = 10; else { - CHECK_NUMBER (base, 1); + CHECK_NUMBER (base); b = XINT (base); if (b < 2 || b > 16) Fsignal (Qargs_out_of_range, Fcons (base, Qnil)); @@ -2344,7 +2473,7 @@ If the base used is not 10, floating point is not recognized. */) /* 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; + p = SDATA (string); while (*p == ' ' || *p == '\t') p++; @@ -2355,7 +2484,7 @@ If the base used is not 10, floating point is not recognized. */) } else if (*p == '+') p++; - + if (isfloat_string (p) && b == 10) val = make_float (sign * atof (p)); else @@ -2427,7 +2556,7 @@ arith_driver (code, nargs, args) { /* Using args[argnum] as argument to CHECK_NUMBER_... */ val = args[argnum]; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) return float_arith_driver ((double) accum, argnum, code, @@ -2496,7 +2625,7 @@ float_arith_driver (accum, argnum, code, nargs, args) for (; argnum < nargs; argnum++) { val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) { @@ -2558,7 +2687,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */) } DEFUN ("-", Fminus, Sminus, 0, MANY, 0, - doc: /* Negate number or subtract numbers or markers. + doc: /* Negate number or subtract numbers or markers and return the result. 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) */) @@ -2570,7 +2699,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) } DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, - doc: /* Returns product of any number of arguments, which are numbers or markers. + doc: /* Return product of any number of arguments, which are numbers or markers. usage: (* &rest NUMBERS-OR-MARKERS) */) (nargs, args) int nargs; @@ -2580,26 +2709,30 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) } DEFUN ("/", Fquo, Squo, 2, MANY, 0, - doc: /* Returns first argument divided by all the remaining arguments. + 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; { + int argnum; + for (argnum = 2; argnum < nargs; argnum++) + if (FLOATP (args[argnum])) + return float_arith_driver (0, 0, Adiv, nargs, args); return arith_driver (Adiv, nargs, args); } DEFUN ("%", Frem, Srem, 2, 2, 0, - doc: /* Returns remainder of X divided by 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); @@ -2632,7 +2765,7 @@ fmod (f1, f2) #endif /* ! HAVE_FMOD */ DEFUN ("mod", Fmod, Smod, 2, 2, 0, - doc: /* Returns X modulo 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) @@ -2641,8 +2774,8 @@ Both X and Y must be numbers or markers. */) Lisp_Object val; EMACS_INT i1, i2; - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x, 0); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y, 1); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); @@ -2727,8 +2860,8 @@ In this case, the sign bit is duplicated. */) { register Lisp_Object val; - CHECK_NUMBER (value, 0); - CHECK_NUMBER (count, 1); + CHECK_NUMBER (value); + CHECK_NUMBER (count); if (XINT (count) >= BITS_PER_EMACS_INT) XSETINT (val, 0); @@ -2744,14 +2877,14 @@ In this case, the sign bit is duplicated. */) DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, 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. */) +In this case, zeros are shifted in on the left. */) (value, count) register Lisp_Object value, count; { register Lisp_Object val; - CHECK_NUMBER (value, 0); - CHECK_NUMBER (count, 1); + CHECK_NUMBER (value); + CHECK_NUMBER (count); if (XINT (count) >= BITS_PER_EMACS_INT) XSETINT (val, 0); @@ -2770,7 +2903,7 @@ Markers are converted to integers. */) (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); @@ -2785,7 +2918,7 @@ Markers are converted to integers. */) (number) register Lisp_Object number; { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0); + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); @@ -2799,10 +2932,24 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, (number) register Lisp_Object number; { - CHECK_NUMBER (number, 0); + CHECK_NUMBER (number); XSETINT (number, ~XINT (number)); return number; } + +DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, + doc: /* Return the byteorder for the machine. +Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII +lowercase l) for small endian machines. */) + () +{ + unsigned i = 0x04030201; + int order = *(char *)&i == 1 ? 108 : 66; + + return make_number (order); +} + + void syms_of_data () @@ -3034,6 +3181,7 @@ syms_of_data () staticpro (&Qargs_out_of_range); staticpro (&Qvoid_function); staticpro (&Qcyclic_function_indirection); + staticpro (&Qcyclic_variable_indirection); staticpro (&Qvoid_variable); staticpro (&Qsetting_constant); staticpro (&Qinvalid_read_syntax); @@ -3119,7 +3267,7 @@ syms_of_data () staticpro (&Qhash_table); defsubr (&Sindirect_variable); - defsubr (&Ssubr_interactive_form); + defsubr (&Sinteractive_form); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -3177,6 +3325,7 @@ syms_of_data () defsubr (&Smake_variable_frame_local); defsubr (&Slocal_variable_p); defsubr (&Slocal_variable_if_set_p); + defsubr (&Svariable_binding_locus); defsubr (&Saref); defsubr (&Saset); defsubr (&Snumber_to_string); @@ -3204,17 +3353,19 @@ syms_of_data () defsubr (&Sadd1); defsubr (&Ssub1); defsubr (&Slognot); + defsubr (&Sbyteorder); defsubr (&Ssubr_arity); + defsubr (&Ssubr_name); XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; - DEFVAR_INT ("most-positive-fixnum", &most_positive_fixnum, - doc: /* The largest value that is representable in a Lisp integer. */); - most_positive_fixnum = MOST_POSITIVE_FIXNUM; - - DEFVAR_INT ("most-negative-fixnum", &most_negative_fixnum, - doc: /* The smallest value that is representable in a Lisp integer. */); - most_negative_fixnum = MOST_NEGATIVE_FIXNUM; + 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 @@ -3236,6 +3387,7 @@ arith_error (signo) sigsetmask (SIGEMPTYMASK); #endif /* not BSD4_1 */ + SIGNAL_THREAD_CHECK (signo); Fsignal (Qarith_error, Qnil); } @@ -3256,3 +3408,6 @@ init_data () signal (SIGEMT, arith_error); #endif /* uts */ } + +/* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7 + (do not change this comment) */