X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e18afed7d695edac870ddf55aabc85c0a95a4b5f..49cdacdad393e2b9282a19a963030dfbe1a738ab:/src/data.c diff --git a/src/data.c b/src/data.c index feacea2c08..09899400b6 100644 --- a/src/data.c +++ b/src/data.c @@ -19,9 +19,7 @@ along with GNU Emacs. If not, see . */ #include -#include #include -#include #include @@ -34,19 +32,7 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ #include "font.h" - -#include -/* 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 - -#include +#include "keymap.h" Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; static Lisp_Object Qsubr; @@ -76,24 +62,26 @@ Lisp_Object Qchar_table_p, Qvector_or_char_table_p; Lisp_Object Qcdr; static Lisp_Object Qad_advice_info, Qad_activate_internal; -Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; -Lisp_Object Qoverflow_error, Qunderflow_error; +static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error; +Lisp_Object Qrange_error, Qoverflow_error; Lisp_Object Qfloatp; Lisp_Object Qnumberp, Qnumber_or_marker_p; -Lisp_Object Qinteger; -static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; +Lisp_Object Qinteger, Qsymbol; +static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector; Lisp_Object Qwindow; -static Lisp_Object Qfloat, Qwindow_configuration; -static Lisp_Object Qprocess; -static Lisp_Object Qcompiled_function, Qframe, Qvector; +static Lisp_Object Qoverlay, Qwindow_configuration; +static Lisp_Object Qprocess, Qmarker; +static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; +static Lisp_Object Qdefun; Lisp_Object Qinteractive_form; +static Lisp_Object Qdefalias_fset_function; static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); @@ -106,7 +94,7 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) to try and do that by checking the tagbits, but nowadays all tagbits are potentially valid. */ /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) - * abort (); */ + * emacs_abort (); */ xsignal2 (Qwrong_type_argument, predicate, value); } @@ -130,7 +118,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) } -/* Data type predicates */ +/* Data type predicates. */ DEFUN ("eq", Feq, Seq, 2, 2, 0, doc: /* Return t if the two args are the same Lisp object. */) @@ -180,7 +168,7 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Misc_Float: return Qfloat; } - abort (); + emacs_abort (); case Lisp_Vectorlike: if (WINDOW_CONFIGURATIONP (object)) @@ -215,7 +203,7 @@ for example, (type-of 1) returns `integer'. */) return Qfloat; default: - abort (); + emacs_abort (); } } @@ -457,7 +445,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, } -/* Extract and set components of lists */ +/* Extract and set components of lists. */ DEFUN ("car", Fcar, Scar, 1, 1, 0, doc: /* Return the car of LIST. If arg is nil, return nil. @@ -515,7 +503,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, return newcdr; } -/* Extract and set components of symbols */ +/* Extract and set components of symbols. */ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, doc: /* Return t if SYMBOL's value is not void. */) @@ -541,7 +529,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, else { swap_in_symval_forwarding (sym, blv); - valcontents = BLV_VALUE (blv); + valcontents = blv_value (blv); } break; } @@ -549,7 +537,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, /* In set_internal, we un-forward vars when their value is set to Qunbound. */ return Qt; - default: abort (); + default: emacs_abort (); } return (EQ (valcontents, Qunbound) ? Qnil : Qt); @@ -560,7 +548,7 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt); + return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt; } DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, @@ -583,7 +571,7 @@ Return SYMBOL. */) CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) xsignal1 (Qsetting_constant, symbol); - XSYMBOL (symbol)->function = Qunbound; + set_symbol_function (symbol, Qunbound); return symbol; } @@ -621,46 +609,63 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, (register Lisp_Object symbol, Lisp_Object definition) { register Lisp_Object function; - CHECK_SYMBOL (symbol); - if (NILP (symbol) || EQ (symbol, Qt)) - xsignal1 (Qsetting_constant, symbol); function = XSYMBOL (symbol)->function; if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); - if (CONSP (function) && EQ (XCAR (function), Qautoload)) + if (AUTOLOADP (function)) Fput (symbol, Qautoload, XCDR (function)); - XSYMBOL (symbol)->function = definition; - /* Handle automatic advice activation */ - if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info))) - { - call2 (Qad_activate_internal, symbol, Qnil); - definition = XSYMBOL (symbol)->function; - } + set_symbol_function (symbol, definition); + return definition; } DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, - doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. + doc: /* Set SYMBOL's function definition to 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. */) +determined by DEFINITION. +The return value is undefined. */) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (CONSP (XSYMBOL (symbol)->function) - && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, symbol)); - definition = Ffset (symbol, definition); - LOADHIST_ATTACH (Fcons (Qdefun, symbol)); + if (!NILP (Vpurify_flag) + /* If `definition' is a keymap, immutable (and copying) is wrong. */ + && !KEYMAPP (definition)) + definition = Fpurecopy (definition); + + { + bool autoload = AUTOLOADP (definition); + if (NILP (Vpurify_flag) || !autoload) + { /* Only add autoload entries after dumping, because the ones before are + not useful and else we get loads of them from the loaddefs.el. */ + + if (AUTOLOADP (XSYMBOL (symbol)->function)) + /* Remember that the function was already an autoload. */ + LOADHIST_ATTACH (Fcons (Qt, symbol)); + LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); + } + } + + { /* Handle automatic advice activation. */ + Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); + if (!NILP (hook)) + call2 (hook, symbol, definition); + else + Ffset (symbol, definition); + } + if (!NILP (docstring)) Fput (symbol, Qfunction_documentation, docstring); - return definition; + /* We used to return `definition', but now that `defun' and `defmacro' expand + to a call to `defalias', we return `symbol' for backward compatibility + (bug#11686). */ + return symbol; } DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, @@ -668,7 +673,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, (register Lisp_Object symbol, Lisp_Object newplist) { CHECK_SYMBOL (symbol); - XSYMBOL (symbol)->plist = newplist; + set_symbol_plist (symbol, newplist); return newplist; } @@ -684,12 +689,10 @@ function with `&rest' args, or `unevalled' for a special form. */) CHECK_SUBR (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)); + return Fcons (make_number (minargs), + maxargs == MANY ? Qmany + : maxargs == UNEVALLED ? Qunevalled + : make_number (maxargs)); } DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, @@ -715,7 +718,7 @@ Value, if non-nil, is a list \(interactive SPEC). */) return Qnil; /* Use an `interactive-form' property if present, analogous to the - function-documentation property. */ + function-documentation property. */ fun = cmd; while (SYMBOLP (fun)) { @@ -739,6 +742,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); } + else if (AUTOLOADP (fun)) + return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil)); else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); @@ -746,14 +751,6 @@ Value, if non-nil, is a list \(interactive SPEC). */) return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); else 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; } @@ -797,10 +794,12 @@ indirect_variable (struct Lisp_Symbol *symbol) 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. */) +If OBJECT is a symbol, follow its variable indirections (if any), and +return the variable at the end of the chain of aliases. See Info node +`(elisp)Variable Aliases'. + +If OBJECT is not a symbol, just return it. If there is a loop in the +chain of aliases, signal a `cyclic-variable-indirection' error. */) (Lisp_Object object) { if (SYMBOLP (object)) @@ -834,7 +833,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) return *XOBJFWD (valcontents)->objvar; case Lisp_Fwd_Buffer_Obj: - return PER_BUFFER_VALUE (current_buffer, + return per_buffer_value (current_buffer, XBUFFER_OBJFWD (valcontents)->offset); case Lisp_Fwd_Kboard_Obj: @@ -851,7 +850,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) don't think anything will break. --lorentey */ return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset + (char *)FRAME_KBOARD (SELECTED_FRAME ())); - default: abort (); + default: emacs_abort (); } } @@ -906,7 +905,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva b = XBUFFER (lbuf); if (! PER_BUFFER_VALUE_P (b, idx)) - PER_BUFFER_VALUE (b, offset) = newval; + set_per_buffer_value (b, offset, newval); } } break; @@ -917,14 +916,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; if (!(NILP (type) || NILP (newval) - || (XINT (type) == LISP_INT_TAG + || (XINT (type) == Lisp_Int0 ? INTEGERP (newval) : XTYPE (newval) == XINT (type)))) buffer_slot_type_mismatch (newval, XINT (type)); if (buf == NULL) buf = current_buffer; - PER_BUFFER_VALUE (buf, offset) = newval; + set_per_buffer_value (buf, offset, newval); } break; @@ -937,12 +936,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva break; default: - abort (); /* goto def; */ + emacs_abort (); /* goto def; */ } } -/* Set up SYMBOL to refer to its global binding. - This makes it safe to alter the status of other bindings. */ +/* Set up SYMBOL to refer to its global binding. This makes it safe + to alter the status of other bindings. BEWARE: this may be called + during the mark phase of GC, where we assume that Lisp_Object slots + of BLV are marked after this function has changed them. */ void swap_in_global_binding (struct Lisp_Symbol *symbol) @@ -951,16 +952,16 @@ swap_in_global_binding (struct Lisp_Symbol *symbol) /* Unload the previously loaded binding. */ if (blv->fwd) - SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); + set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Select the global binding in the symbol. */ - blv->valcell = blv->defcell; + set_blv_valcell (blv, blv->defcell); if (blv->fwd) store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL); /* Indicate that the global binding is set up now. */ - blv->where = Qnil; - SET_BLV_FOUND (blv, 0); + set_blv_where (blv, Qnil); + set_blv_found (blv, 0); } /* Set up the buffer-local symbol SYMBOL for validity in the current buffer. @@ -988,7 +989,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ /* Unload the previously loaded binding. */ tem1 = blv->valcell; if (blv->fwd) - SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); + set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ { Lisp_Object var; @@ -996,21 +997,21 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ if (blv->frame_local) { tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist); - blv->where = selected_frame; + set_blv_where (blv, selected_frame); } else { tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); - XSETBUFFER (blv->where, current_buffer); + set_blv_where (blv, Fcurrent_buffer ()); } } if (!(blv->found = !NILP (tem1))) tem1 = blv->defcell; /* Load the new binding. */ - blv->valcell = tem1; + set_blv_valcell (blv, tem1); if (blv->fwd) - store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL); + store_symval_forwarding (blv->fwd, blv_value (blv), NULL); } } @@ -1037,12 +1038,12 @@ find_symbol_value (Lisp_Object symbol) { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); swap_in_symval_forwarding (sym, blv); - return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv); + return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv); } /* FALLTHROUGH */ case SYMBOL_FORWARDED: return do_symval_forwarding (SYMBOL_FWD (sym)); - default: abort (); + default: emacs_abort (); } } @@ -1067,52 +1068,53 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, return newval; } -/* Return 1 if SYMBOL currently has a let-binding +/* Return true if SYMBOL currently has a let-binding which was made in the buffer that is now current. */ -static int +static bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) { struct specbinding *p; - for (p = specpdl_ptr - 1; p >= specpdl; p--) - if (p->func == NULL + for (p = specpdl_ptr; p > specpdl; ) + if ((--p)->func == NULL && CONSP (p->symbol)) { struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); if (symbol == let_bound_symbol && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) - break; + return 1; } - return p >= specpdl; + return 0; } -static int +static bool let_shadows_global_binding_p (Lisp_Object symbol) { struct specbinding *p; - for (p = specpdl_ptr - 1; p >= specpdl; p--) - if (p->func == NULL && EQ (p->symbol, symbol)) - break; + for (p = specpdl_ptr; p > specpdl; ) + if ((--p)->func == NULL && EQ (p->symbol, symbol)) + return 1; - return p >= specpdl; + return 0; } /* Store the value NEWVAL into SYMBOL. If buffer/frame-locality is an issue, WHERE specifies which context to use. (nil stands for the current buffer/frame). - If BINDFLAG is zero, then if this symbol is supposed to become + If BINDFLAG is false, 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. */ + If BINDFLAG is true, we don't do that. */ void -set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag) +set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag) { - int voide = EQ (newval, Qunbound); + bool voide = EQ (newval, Qunbound); struct Lisp_Symbol *sym; Lisp_Object tem1; @@ -1154,7 +1156,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register the default binding is loaded, the loaded binding may be the wrong one. */ if (!EQ (blv->where, where) - /* Also unload a global binding (if the var is local_if_set). */ + /* Also unload a global binding (if the var is local_if_set). */ || (EQ (blv->valcell, blv->defcell))) { /* The currently loaded binding is not necessarily valid. @@ -1162,7 +1164,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register /* Write out `realvalue' to the old loaded binding. */ if (blv->fwd) - SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); + set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Find the new binding. */ XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ @@ -1170,7 +1172,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register (blv->frame_local ? XFRAME (where)->param_alist : BVAR (XBUFFER (where), local_var_alist))); - blv->where = where; + set_blv_where (blv, where); blv->found = 1; if (NILP (tem1)) @@ -1200,17 +1202,18 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register bindings, not for frame-local bindings. */ eassert (!blv->frame_local); tem1 = Fcons (symbol, XCDR (blv->defcell)); - BVAR (XBUFFER (where), local_var_alist) - = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); + bset_local_var_alist + (XBUFFER (where), + Fcons (tem1, BVAR (XBUFFER (where), local_var_alist))); } } /* Record which binding is now loaded. */ - blv->valcell = tem1; + set_blv_valcell (blv, tem1); } /* Store the new value in the cons cell. */ - SET_BLV_VALUE (blv, newval); + set_blv_value (blv, newval); if (blv->fwd) { @@ -1250,7 +1253,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register store_symval_forwarding (/* sym, */ innercontents, newval, buf); break; } - default: abort (); + default: emacs_abort (); } return; } @@ -1295,13 +1298,13 @@ default_value (Lisp_Object symbol) { int offset = XBUFFER_OBJFWD (valcontents)->offset; if (PER_BUFFER_IDX (offset) != 0) - return PER_BUFFER_DEFAULT (offset); + return per_buffer_default (offset); } /* For other variables, get the current value. */ return do_symval_forwarding (valcontents); } - default: abort (); + default: emacs_abort (); } } @@ -1382,7 +1385,7 @@ for this variable. */) int offset = XBUFFER_OBJFWD (valcontents)->offset; int idx = PER_BUFFER_IDX (offset); - PER_BUFFER_DEFAULT (offset) = value; + set_per_buffer_default (offset, value); /* If this variable is not always local in all buffers, set it in the buffers that don't nominally have a local value. */ @@ -1390,16 +1393,16 @@ for this variable. */) { struct buffer *b; - for (b = all_buffers; b; b = b->header.next.buffer) + FOR_EACH_BUFFER (b) if (!PER_BUFFER_VALUE_P (b, idx)) - PER_BUFFER_VALUE (b, offset) = value; + set_per_buffer_value (b, offset, value); } return value; } else return Fset (symbol, value); } - default: abort (); + default: emacs_abort (); } } @@ -1450,10 +1453,10 @@ union Lisp_Val_Fwd }; static struct Lisp_Buffer_Local_Value * -make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents) +make_blv (struct Lisp_Symbol *sym, bool forwarded, + union Lisp_Val_Fwd valcontents) { - struct Lisp_Buffer_Local_Value *blv - = xmalloc (sizeof (struct Lisp_Buffer_Local_Value)); + struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); Lisp_Object symbol; Lisp_Object tem; @@ -1467,12 +1470,12 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd))); eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd))); blv->fwd = forwarded ? valcontents.fwd : NULL; - blv->where = Qnil; + set_blv_where (blv, Qnil); blv->frame_local = 0; blv->local_if_set = 0; - blv->defcell = tem; - blv->valcell = tem; - SET_BLV_FOUND (blv, 0); + set_blv_defcell (blv, tem); + set_blv_valcell (blv, tem); + set_blv_found (blv, 0); return blv; } @@ -1494,8 +1497,8 @@ The function `default-value' gets the default value and `set-default' sets it. { struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; - union Lisp_Val_Fwd valcontents IF_LINT (= {0}); - int forwarded IF_LINT (= 0); + union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); + bool forwarded IF_LINT (= 0); CHECK_SYMBOL (variable); sym = XSYMBOL (variable); @@ -1523,7 +1526,7 @@ The function `default-value' gets the default value and `set-default' sets it. else if (BUFFER_OBJFWDP (valcontents.fwd)) return variable; break; - default: abort (); + default: emacs_abort (); } if (sym->constant) @@ -1567,11 +1570,11 @@ 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. */) - (register Lisp_Object variable) + (Lisp_Object variable) { - register Lisp_Object tem; - int forwarded IF_LINT (= 0); - union Lisp_Val_Fwd valcontents IF_LINT (= {0}); + Lisp_Object tem; + bool forwarded IF_LINT (= 0); + union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; @@ -1596,7 +1599,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); break; - default: abort (); + default: emacs_abort (); } if (sym->constant) @@ -1641,17 +1644,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default value. */ find_symbol_value (variable); - BVAR (current_buffer, local_var_alist) - = Fcons (Fcons (variable, XCDR (blv->defcell)), - BVAR (current_buffer, local_var_alist)); + bset_local_var_alist + (current_buffer, + Fcons (Fcons (variable, XCDR (blv->defcell)), + BVAR (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. */ if (current_buffer == XBUFFER (blv->where)) - blv->where = Qnil; - /* blv->valcell = blv->defcell; - * SET_BLV_FOUND (blv, 0); */ - blv->found = 0; + set_blv_where (blv, Qnil); + set_blv_found (blv, 0); } /* If the symbol forwards into a C variable, then load the binding @@ -1693,8 +1695,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) if (idx > 0) { SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); - PER_BUFFER_VALUE (current_buffer, offset) - = PER_BUFFER_DEFAULT (offset); + set_per_buffer_value (current_buffer, offset, + per_buffer_default (offset)); } } return variable; @@ -1704,15 +1706,16 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) if (blv->frame_local) return variable; break; - default: abort (); + default: emacs_abort (); } /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - BVAR (current_buffer, local_var_alist) - = Fdelq (tem, BVAR (current_buffer, local_var_alist)); + bset_local_var_alist + (current_buffer, + Fdelq (tem, BVAR (current_buffer, local_var_alist))); /* If the symbol is set up with the current buffer's binding loaded, recompute its value. We have to do it now, or else @@ -1721,9 +1724,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) Lisp_Object buf; XSETBUFFER (buf, current_buffer); if (EQ (buf, blv->where)) { - blv->where = Qnil; - /* blv->valcell = blv->defcell; - * SET_BLV_FOUND (blv, 0); */ + set_blv_where (blv, Qnil); blv->found = 0; find_symbol_value (variable); } @@ -1756,9 +1757,9 @@ is to set the VARIABLE frame parameter of that frame. See Note that since Emacs 23.1, variables cannot be both buffer-local and frame-local any more (buffer-local bindings used to take precedence over frame-local bindings). */) - (register Lisp_Object variable) + (Lisp_Object variable) { - int forwarded; + bool forwarded; union Lisp_Val_Fwd valcontents; struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; @@ -1787,7 +1788,7 @@ frame-local bindings). */) error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); break; - default: abort (); + default: emacs_abort (); } if (sym->constant) @@ -1845,11 +1846,11 @@ BUFFER defaults to the current buffer. */) if (EQ (variable, XCAR (elt))) { eassert (!blv->frame_local); - eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp)); + eassert (blv_found (blv) || !EQ (blv->where, tmp)); return Qt; } } - eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp)); + eassert (!blv_found (blv) || !EQ (blv->where, tmp)); return Qnil; } case SYMBOL_FORWARDED: @@ -1864,18 +1865,18 @@ BUFFER defaults to the current buffer. */) } return Qnil; } - default: abort (); + default: emacs_abort (); } } 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 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. */) + doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there. +BUFFER defaults to the current buffer. + +More precisely, return non-nil if either VARIABLE already has a local +value in BUFFER, or if VARIABLE is automatically buffer-local (see +`make-variable-buffer-local'). */) (register Lisp_Object variable, Lisp_Object buffer) { struct Lisp_Symbol *sym; @@ -1899,7 +1900,7 @@ BUFFER defaults to the current buffer. */) case SYMBOL_FORWARDED: /* All BUFFER_OBJFWD slots become local if they are set. */ return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil); - default: abort (); + default: emacs_abort (); } } @@ -1939,11 +1940,11 @@ If the current binding is global (the default), the value is nil. */) if (!NILP (Flocal_variable_p (variable, Qnil))) return Fcurrent_buffer (); else if (sym->redirect == SYMBOL_LOCALIZED - && BLV_FOUND (SYMBOL_BLV (sym))) + && blv_found (SYMBOL_BLV (sym))) return SYMBOL_BLV (sym)->where; else return Qnil; - default: abort (); + default: emacs_abort (); } } @@ -2049,7 +2050,7 @@ function chain of symbols. */) return Qnil; } -/* Extract and set vector and string elements */ +/* Extract and set vector and string elements. */ DEFUN ("aref", Faref, Saref, 2, 2, 0, doc: /* Return the element of ARRAY at index IDX. @@ -2064,7 +2065,7 @@ or a byte-code object. IDX starts at 0. */) if (STRINGP (array)) { int c; - EMACS_INT idxval_byte; + ptrdiff_t idxval_byte; if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); @@ -2092,7 +2093,7 @@ or a byte-code object. IDX starts at 0. */) } else { - int size = 0; + ptrdiff_t size = 0; if (VECTORP (array)) size = ASIZE (array); else if (COMPILEDP (array)) @@ -2123,7 +2124,7 @@ bool-vector. IDX starts at 0. */) { if (idxval < 0 || idxval >= ASIZE (array)) args_out_of_range (array, idx); - XVECTOR (array)->contents[idxval] = newelt; + ASET (array, idxval, newelt); } else if (BOOL_VECTOR_P (array)) { @@ -2156,7 +2157,8 @@ bool-vector. IDX starts at 0. */) if (STRING_MULTIBYTE (array)) { - EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes; + ptrdiff_t idxval_byte, nbytes; + int prev_bytes, new_bytes; unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; nbytes = SBYTES (array); @@ -2167,11 +2169,10 @@ bool-vector. IDX starts at 0. */) if (prev_bytes != new_bytes) { /* We must relocate the string data. */ - EMACS_INT nchars = SCHARS (array); - unsigned char *str; + ptrdiff_t nchars = SCHARS (array); USE_SAFE_ALLOCA; + unsigned char *str = SAFE_ALLOCA (nbytes); - SAFE_ALLOCA (str, unsigned char *, nbytes); memcpy (str, SDATA (array), nbytes); allocate_string_data (XSTRING (array), nchars, nbytes + new_bytes - prev_bytes); @@ -2214,7 +2215,7 @@ static Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) { double f1 = 0, f2 = 0; - int floatp = 0; + bool floatp = 0; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); @@ -2259,7 +2260,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) return Qnil; default: - abort (); + emacs_abort (); } } @@ -2331,7 +2332,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, uintmax_t cons_to_unsigned (Lisp_Object c, uintmax_t max) { - int valid = 0; + bool valid = 0; uintmax_t val IF_LINT (= 0); if (INTEGERP (c)) { @@ -2384,7 +2385,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max) intmax_t cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { - int valid = 0; + bool valid = 0; intmax_t val IF_LINT (= 0); if (INTEGERP (c)) { @@ -2437,20 +2438,17 @@ Uses a minus sign if negative. NUMBER may be an integer or a floating point number. */) (Lisp_Object number) { - char buffer[VALBITS]; + char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; + int len; CHECK_NUMBER_OR_FLOAT (number); if (FLOATP (number)) - { - char pigbuf[FLOAT_TO_STRING_BUFSIZE]; - - float_to_string (pigbuf, XFLOAT_DATA (number)); - return build_string (pigbuf); - } + len = float_to_string (buffer, XFLOAT_DATA (number)); + else + len = sprintf (buffer, "%"pI"d", XINT (number)); - sprintf (buffer, "%"pI"d", XINT (number)); - return build_string (buffer); + return make_unibyte_string (buffer, len); } DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, @@ -2474,9 +2472,9 @@ If the base used is not 10, STRING is always parsed as integer. */) else { CHECK_NUMBER (base); - b = XINT (base); - if (b < 2 || b > 16) + if (! (2 <= XINT (base) && XINT (base) <= 16)) xsignal1 (Qargs_out_of_range, base); + b = XINT (base); } p = SSDATA (string); @@ -2505,16 +2503,13 @@ static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, static Lisp_Object arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) { - register Lisp_Object val; - ptrdiff_t argnum; - register EMACS_INT accum = 0; - register EMACS_INT next; - - int overflow = 0; - ptrdiff_t ok_args; - EMACS_INT ok_accum; + Lisp_Object val; + ptrdiff_t argnum, ok_args; + EMACS_INT accum = 0; + EMACS_INT next, ok_accum; + bool overflow = 0; - switch (SWITCH_ENUM_CAST (code)) + switch (code) { case Alogior: case Alogxor: @@ -2549,7 +2544,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) nargs, args); args[argnum] = val; next = XINT (args[argnum]); - switch (SWITCH_ENUM_CAST (code)) + switch (code) { case Aadd: if (INT_ADD_OVERFLOW (accum, next)) @@ -2635,7 +2630,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, args[argnum] = val; /* runs into a compiler bug. */ next = XINT (args[argnum]); } - switch (SWITCH_ENUM_CAST (code)) + switch (code) { case Aadd: accum += next; @@ -2701,10 +2696,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) return arith_driver (Amult, nargs, args); } -DEFUN ("/", Fquo, Squo, 2, MANY, 0, +DEFUN ("/", Fquo, Squo, 1, MANY, 0, doc: /* Return first argument divided by all the remaining arguments. The arguments must be numbers or markers. -usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) +usage: (/ DIVIDEND &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t argnum; @@ -2724,35 +2719,13 @@ Both must be integers or markers. */) CHECK_NUMBER_COERCE_MARKER (x); CHECK_NUMBER_COERCE_MARKER (y); - if (XFASTINT (y) == 0) + if (XINT (y) == 0) xsignal0 (Qarith_error); XSETINT (val, XINT (x) % XINT (y)); return val; } -#ifndef HAVE_FMOD -double -fmod (double f1, double f2) -{ - double r = f1; - - if (f2 < 0.0) - f2 = -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, doc: /* Return X modulo Y. The result falls between zero (inclusive) and Y (exclusive). @@ -3003,11 +2976,11 @@ syms_of_data (void) Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, - make_pure_c_string ("error")); + build_pure_c_string ("error")); #define PUT_ERROR(sym, tail, msg) \ Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ - Fput (sym, Qerror_message, make_pure_c_string (msg)) + Fput (sym, Qerror_message, build_pure_c_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); @@ -3034,7 +3007,7 @@ syms_of_data (void) arith_tail = pure_cons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); - Fput (Qarith_error, Qerror_message, make_pure_c_string ("Arithmetic error")); + Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error")); PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); @@ -3075,7 +3048,6 @@ syms_of_data (void) DEFSYM (Qwindow_configuration, "window-configuration"); DEFSYM (Qprocess, "process"); DEFSYM (Qwindow, "window"); - /* DEFSYM (Qsubr, "subr"); */ DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); @@ -3083,12 +3055,16 @@ syms_of_data (void) DEFSYM (Qchar_table, "char-table"); DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); + DEFSYM (Qmisc, "misc"); + + DEFSYM (Qdefun, "defun"); DEFSYM (Qfont_spec, "font-spec"); DEFSYM (Qfont_entity, "font-entity"); DEFSYM (Qfont_object, "font-object"); DEFSYM (Qinteractive_form, "interactive-form"); + DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); @@ -3185,7 +3161,7 @@ syms_of_data (void) defsubr (&Ssubr_arity); defsubr (&Ssubr_name); - XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; + set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function); DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. */); @@ -3197,30 +3173,3 @@ syms_of_data (void) Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; } - -#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD -static void arith_error (int) NO_RETURN; -#endif - -static void -arith_error (int signo) -{ - sigsetmask (SIGEMPTYMASK); - - SIGNAL_THREAD_CHECK (signo); - xsignal0 (Qarith_error); -} - -void -init_data (void) -{ - /* Don't do this if just dumping out. - We don't want to call `signal' in this case - so that we don't have trouble with dumping - signal-delivering routines in an inconsistent state. */ -#ifndef CANNOT_DUMP - if (!initialized) - return; -#endif /* CANNOT_DUMP */ - signal (SIGFPE, arith_error); -}