X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8678d9e413593b0abab296551a20589745c459da..9587a89da041d3848bd6b639e836d70cb40b4bd6:/src/data.c diff --git a/src/data.c b/src/data.c index c0557d5c73..956ff3700f 100644 --- a/src/data.c +++ b/src/data.c @@ -52,26 +52,33 @@ along with GNU Emacs. If not, see . */ extern double atof (const char *); #endif /* !atof */ -Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; +Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; +static Lisp_Object Qsubr; 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 Qerror, Qquit, Qargs_out_of_range; +static Lisp_Object Qwrong_type_argument; +Lisp_Object Qvoid_variable, Qvoid_function; +static Lisp_Object Qcyclic_function_indirection; +static Lisp_Object Qcyclic_variable_indirection; +Lisp_Object Qcircular_list; +static Lisp_Object Qsetting_constant; +Lisp_Object 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 Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp; +static Lisp_Object Qnatnump; Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; -Lisp_Object Qbuffer_or_string_p, Qkeywordp; -Lisp_Object Qboundp, Qfboundp; +Lisp_Object Qbuffer_or_string_p; +static Lisp_Object Qkeywordp, Qboundp; +Lisp_Object Qfboundp; Lisp_Object Qchar_table_p, Qvector_or_char_table_p; Lisp_Object Qcdr; -Lisp_Object Qad_advice_info, Qad_activate_internal; +static Lisp_Object Qad_advice_info, Qad_activate_internal; Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; Lisp_Object Qoverflow_error, Qunderflow_error; @@ -83,7 +90,7 @@ Lisp_Object Qinteger; static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; Lisp_Object Qwindow; static Lisp_Object Qfloat, Qwindow_configuration; -Lisp_Object Qprocess; +static Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; @@ -94,13 +101,6 @@ Lisp_Object Qinteractive_form; static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); -void -circular_list_error (Lisp_Object list) -{ - xsignal (Qcircular_list, list); -} - - Lisp_Object wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) { @@ -745,7 +745,9 @@ Value, if non-nil, is a list \(interactive SPEC). */) else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qlambda)) + if (EQ (funcar, Qclosure)) + return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); + else if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) { @@ -805,7 +807,10 @@ variable chain of symbols. */) (Lisp_Object object) { if (SYMBOLP (object)) - XSETSYMBOL (object, indirect_variable (XSYMBOL (object))); + { + struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object)); + XSETSYMBOL (object, sym); + } return object; } @@ -815,9 +820,6 @@ variable chain of symbols. */) This does not handle buffer-local variables; use swap_in_symval_forwarding for that. */ -#define do_blv_forwarding(blv) \ - ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv)) - Lisp_Object do_symval_forwarding (register union Lisp_Fwd *valcontents) { @@ -864,14 +866,6 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) BUF non-zero means set the value in buffer BUF instead of the current buffer. This only plays a role for per-buffer variables. */ -#define store_blv_forwarding(blv, newval, buf) \ - do { \ - if ((blv)->forwarded) \ - store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \ - else \ - SET_BLV_VALUE (blv, newval); \ - } while (0) - static void store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newval, struct buffer *buf) { @@ -907,12 +901,12 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { - Lisp_Object buf; + Lisp_Object lbuf; struct buffer *b; - buf = Fcdr (XCAR (tail)); - if (!BUFFERP (buf)) continue; - b = XBUFFER (buf); + lbuf = Fcdr (XCAR (tail)); + if (!BUFFERP (lbuf)) continue; + b = XBUFFER (lbuf); if (! PER_BUFFER_VALUE_P (b, idx)) PER_BUFFER_VALUE (b, offset) = newval; @@ -1009,7 +1003,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ } else { - tem1 = assq_no_quit (var, B_ (current_buffer, local_var_alist)); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); XSETBUFFER (blv->where, current_buffer); } } @@ -1178,7 +1172,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register tem1 = Fassq (symbol, (blv->frame_local ? XFRAME (where)->param_alist - : B_ (XBUFFER (where), local_var_alist))); + : BVAR (XBUFFER (where), local_var_alist))); blv->where = where; blv->found = 1; @@ -1209,8 +1203,8 @@ 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)); - B_ (XBUFFER (where), local_var_alist) - = Fcons (tem1, B_ (XBUFFER (where), local_var_alist)); + BVAR (XBUFFER (where), local_var_alist) + = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); } } @@ -1269,7 +1263,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register /* Return the default value of SYMBOL, but don't check for voidness. Return Qunbound if it is void. */ -Lisp_Object +static Lisp_Object default_value (Lisp_Object symbol) { struct Lisp_Symbol *sym; @@ -1439,7 +1433,7 @@ usage: (setq-default [VAR VALUE]...) */) do { - val = Feval (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (Fcdr (args_left))); symbol = XCAR (args_left); Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); @@ -1485,8 +1479,8 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents return blv; } -DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local, - 1, 1, "vMake Variable Buffer Local: ", +DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, + Smake_variable_buffer_local, 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, @@ -1503,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; - int forwarded; + union Lisp_Val_Fwd valcontents IF_LINT (= {0}); + int forwarded IF_LINT (= 0); CHECK_SYMBOL (variable); sym = XSYMBOL (variable); @@ -1579,8 +1573,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) (register Lisp_Object variable) { register Lisp_Object tem; - int forwarded; - union Lisp_Val_Fwd valcontents; + int forwarded IF_LINT (= 0); + union Lisp_Val_Fwd valcontents IF_LINT (= {0}); struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; @@ -1632,13 +1626,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) if (let_shadows_global_binding_p (symbol)) message ("Making %s local to %s while let-bound!", SDATA (SYMBOL_NAME (variable)), - SDATA (B_ (current_buffer, name))); + SDATA (BVAR (current_buffer, name))); } } /* Make sure this buffer has its own value of symbol. */ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - tem = Fassq (variable, B_ (current_buffer, local_var_alist)); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { if (let_shadows_buffer_binding_p (sym)) @@ -1650,9 +1644,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default value. */ find_symbol_value (variable); - B_ (current_buffer, local_var_alist) + BVAR (current_buffer, local_var_alist) = Fcons (Fcons (variable, XCDR (blv->defcell)), - B_ (current_buffer, local_var_alist)); + 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. */ @@ -1718,10 +1712,10 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ - tem = Fassq (variable, B_ (current_buffer, local_var_alist)); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - B_ (current_buffer, local_var_alist) - = Fdelq (tem, B_ (current_buffer, local_var_alist)); + BVAR (current_buffer, local_var_alist) + = 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 @@ -1848,7 +1842,7 @@ BUFFER defaults to the current buffer. */) XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); if (EQ (variable, XCAR (elt))) @@ -1961,7 +1955,8 @@ If the current binding is global (the default), the value is nil. */) #if 0 extern struct terminal *get_terminal (Lisp_Object display, int); -DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0, +DEFUN ("terminal-local-value", Fterminal_local_value, + Sterminal_local_value, 2, 2, 0, doc: /* Return the terminal-local value of SYMBOL on TERMINAL. If SYMBOL is not a terminal-local variable, then return its normal value, like `symbol-value'. @@ -1978,7 +1973,8 @@ selected frame's terminal device). */) return result; } -DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0, +DEFUN ("set-terminal-local-value", Fset_terminal_local_value, + Sset_terminal_local_value, 3, 3, 0, doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE. If VARIABLE is not a terminal-local variable, then set its normal binding, like `set'. @@ -2109,7 +2105,7 @@ or a byte-code object. IDX starts at 0. */) if (idxval < 0 || idxval >= size) args_out_of_range (array, idx); - return XVECTOR (array)->contents[idxval]; + return AREF (array, idxval); } } @@ -2216,7 +2212,7 @@ bool-vector. IDX starts at 0. */) enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; -Lisp_Object +static Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) { double f1 = 0, f2 = 0; @@ -2482,13 +2478,13 @@ enum arithop Amin }; -static Lisp_Object float_arith_driver (double, int, enum arithop, - int, Lisp_Object *); -Lisp_Object -arith_driver (enum arithop code, int nargs, register Lisp_Object *args) +static Lisp_Object float_arith_driver (double, size_t, enum arithop, + size_t, Lisp_Object *); +static Lisp_Object +arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args) { register Lisp_Object val; - register int argnum; + register size_t argnum; register EMACS_INT accum = 0; register EMACS_INT next; @@ -2570,7 +2566,8 @@ arith_driver (enum arithop code, int nargs, register Lisp_Object *args) #define isnan(x) ((x) != (x)) static Lisp_Object -float_arith_driver (double accum, register int argnum, enum arithop code, int nargs, register Lisp_Object *args) +float_arith_driver (double accum, register size_t argnum, enum arithop code, + size_t nargs, register Lisp_Object *args) { register Lisp_Object val; double next; @@ -2632,7 +2629,7 @@ float_arith_driver (double accum, register int argnum, enum arithop code, int na DEFUN ("+", Fplus, Splus, 0, MANY, 0, doc: /* Return sum of any number of arguments, which are numbers or markers. usage: (+ &rest NUMBERS-OR-MARKERS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Aadd, nargs, args); } @@ -2642,7 +2639,7 @@ DEFUN ("-", Fminus, Sminus, 0, MANY, 0, 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) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Asub, nargs, args); } @@ -2650,7 +2647,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, doc: /* Return product of any number of arguments, which are numbers or markers. usage: (* &rest NUMBERS-OR-MARKERS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Amult, nargs, args); } @@ -2659,9 +2656,9 @@ DEFUN ("/", Fquo, Squo, 2, MANY, 0, doc: /* Return first argument divided by all the remaining arguments. The arguments must be numbers or markers. usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { - int argnum; + size_t argnum; for (argnum = 2; argnum < nargs; argnum++) if (FLOATP (args[argnum])) return float_arith_driver (0, 0, Adiv, nargs, args); @@ -2743,7 +2740,7 @@ DEFUN ("max", Fmax, Smax, 1, MANY, 0, 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) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Amax, nargs, args); } @@ -2752,7 +2749,7 @@ DEFUN ("min", Fmin, Smin, 1, MANY, 0, 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) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Amin, nargs, args); } @@ -2761,7 +2758,7 @@ DEFUN ("logand", Flogand, Slogand, 0, MANY, 0, doc: /* Return bitwise-and of all the arguments. Arguments may be integers, or markers converted to integers. usage: (logand &rest INTS-OR-MARKERS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Alogand, nargs, args); } @@ -2770,7 +2767,7 @@ DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, doc: /* Return bitwise-or of all the arguments. Arguments may be integers, or markers converted to integers. usage: (logior &rest INTS-OR-MARKERS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Alogior, nargs, args); } @@ -2779,7 +2776,7 @@ DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, doc: /* Return bitwise-exclusive-or of all the arguments. Arguments may be integers, or markers converted to integers. usage: (logxor &rest INTS-OR-MARKERS) */) - (int nargs, Lisp_Object *args) + (size_t nargs, Lisp_Object *args) { return arith_driver (Alogxor, nargs, args); } @@ -3308,7 +3305,7 @@ syms_of_data (void) XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; } -SIGTYPE +static void arith_error (int signo) { sigsetmask (SIGEMPTYMASK);