X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/220d91b834f7f7252b9953460422151b86b3520c..9587a89da041d3848bd6b639e836d70cb40b4bd6:/src/data.c diff --git a/src/data.c b/src/data.c index c28dc9b4ba..956ff3700f 100644 --- a/src/data.c +++ b/src/data.c @@ -1,6 +1,5 @@ /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000, - 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -53,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; @@ -84,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,15 +100,6 @@ Lisp_Object Qinteractive_form; static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); -Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum; - - -void -circular_list_error (Lisp_Object list) -{ - xsignal (Qcircular_list, list); -} - Lisp_Object wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) @@ -135,21 +132,6 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) xsignal3 (Qargs_out_of_range, a1, a2, a3); } -/* On some machines, XINT needs a temporary location. - Here it is, in case it is needed. */ - -int sign_extend_temp; - -/* On a few machines, XINT can only be done by calling this. */ - -int -sign_extend_lisp_int (EMACS_INT num) -{ - if (num & (((EMACS_INT) 1) << (VALBITS - 1))) - return num | (((EMACS_INT) (-1)) << VALBITS); - else - return num & ((((EMACS_INT) 1) << VALBITS) - 1); -} /* Data type predicates */ @@ -763,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)) { @@ -823,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; } @@ -833,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) { @@ -882,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) { @@ -925,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; @@ -1027,7 +1003,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ } else { - tem1 = assq_no_quit (var, current_buffer->local_var_alist); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); XSETBUFFER (blv->where, current_buffer); } } @@ -1196,7 +1172,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register tem1 = Fassq (symbol, (blv->frame_local ? XFRAME (where)->param_alist - : XBUFFER (where)->local_var_alist)); + : BVAR (XBUFFER (where), local_var_alist))); blv->where = where; blv->found = 1; @@ -1227,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)); - XBUFFER (where)->local_var_alist - = Fcons (tem1, XBUFFER (where)->local_var_alist); + BVAR (XBUFFER (where), local_var_alist) + = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); } } @@ -1287,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; @@ -1457,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)); @@ -1503,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, @@ -1521,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); @@ -1597,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; @@ -1650,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 (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, current_buffer->local_var_alist); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { if (let_shadows_buffer_binding_p (sym)) @@ -1668,9 +1644,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default value. */ find_symbol_value (variable); - current_buffer->local_var_alist + BVAR (current_buffer, local_var_alist) = Fcons (Fcons (variable, XCDR (blv->defcell)), - 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. */ @@ -1736,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, current_buffer->local_var_alist); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - current_buffer->local_var_alist - = Fdelq (tem, 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 @@ -1866,7 +1842,7 @@ BUFFER defaults to the current buffer. */) XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - for (tail = 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))) @@ -1979,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'. @@ -1996,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'. @@ -2127,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); } } @@ -2234,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; @@ -2390,7 +2368,7 @@ NUMBER may be an integer or a floating point number. */) if (FLOATP (number)) { - char pigbuf[350]; /* see comments in float_to_string */ + char pigbuf[FLOAT_TO_STRING_BUFSIZE]; float_to_string (pigbuf, XFLOAT_DATA (number)); return build_string (pigbuf); @@ -2435,7 +2413,7 @@ present, base 10 is used. BASE must be between 2 and 16 (inclusive). If the base used is not 10, STRING is always parsed as integer. */) (register Lisp_Object string, Lisp_Object base) { - register unsigned char *p; + register char *p; register int b; int sign = 1; Lisp_Object val; @@ -2454,7 +2432,7 @@ If the base used is not 10, STRING is always parsed as integer. */) /* 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 = SDATA (string); + p = SSDATA (string); while (*p == ' ' || *p == '\t') p++; @@ -2500,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; @@ -2588,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; @@ -2650,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); } @@ -2660,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); } @@ -2668,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); } @@ -2677,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); @@ -2761,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); } @@ -2770,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); } @@ -2779,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); } @@ -2788,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); } @@ -2797,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); } @@ -3315,18 +3294,18 @@ syms_of_data (void) XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; - DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_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); XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1; - DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_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); XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; } -SIGTYPE +static void arith_error (int signo) { sigsetmask (SIGEMPTYMASK); @@ -3352,6 +3331,3 @@ init_data (void) signal (SIGEMT, arith_error); #endif /* uts */ } - -/* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7 - (do not change this comment) */