/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
}
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
- doc: /* Return SYMBOL's function definition. Error if that is void. */)
+ doc: /* Return SYMBOL's function definition, or nil if that is void. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
+ /* Convert to eassert or remove after GC bug is found. In the
+ meantime, check unconditionally, at a slight perf hit. */
+ if (valid_lisp_object_p (definition) < 1)
+ emacs_abort ();
+
set_symbol_function (symbol, definition);
return definition;
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.
+
+Internally, this normally uses `fset', but if SYMBOL has a
+`defalias-fset-function' property, the associated value is used instead.
+
The return value is undefined. */)
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
a `let'-style binding made in this buffer is in effect,
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.
+This globally affects all uses of this variable, so it belongs together with
+the variable declaration, rather than with its uses (if you just want to make
+a variable local to the current buffer for one particular use, use
+`make-local-variable'). Buffer-local bindings are normally cleared
+while setting up a new major mode, unless they have a `permanent-local'
+property.
The function `default-value' gets the default value and `set-default' sets it. */)
(register Lisp_Object variable)
arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
- for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+ ptrdiff_t argnum;
+ for (argnum = 1; argnum < nargs; ++argnum)
{
if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
return Qnil;
DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
doc: /* Return t if each arg is greater than or equal to the next arg.
All must be numbers or markers.
-usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
+usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
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, and all trailing chars.
+Ignore leading spaces and tabs, and all trailing chars. Return 0 if
+STRING cannot be parsed as an integer or floating point number.
If BASE, interpret STRING as a number in that base. If BASE isn't
present, base 10 is used. BASE must be between 2 and 16 (inclusive).
-If the base used is not 10, STRING is always parsed as integer. */)
+If the base used is not 10, STRING is always parsed as an integer. */)
(register Lisp_Object string, Lisp_Object base)
{
register char *p;
/* Info about unsigned long long, falling back on unsigned long
if unsigned long long is not available. */
-#if HAVE_UNSIGNED_LONG_LONG_INT
+#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_MAX
enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) };
+# define ULL_MAX ULLONG_MAX
#else
enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) };
-# define ULLONG_MAX ULONG_MAX
+# define ULL_MAX ULONG_MAX
# define count_one_bits_ll count_one_bits_l
+# define count_trailing_zeros_ll count_trailing_zeros_l
#endif
/* Shift VAL right by the width of an unsigned long long.
{
int i = 0, count = 0;
while (count += count_one_bits_ll (w),
- BITS_PER_BITS_WORD <= (i += BITS_PER_ULL))
+ (i += BITS_PER_ULL) < BITS_PER_BITS_WORD)
w = shift_right_ull (w);
return count;
}
bool_vector_subsetp };
static Lisp_Object
-bool_vector_binop_driver (Lisp_Object op1,
- Lisp_Object op2,
+bool_vector_binop_driver (Lisp_Object a,
+ Lisp_Object b,
Lisp_Object dest,
enum bool_vector_op op)
{
EMACS_INT nr_bits;
- bits_word *adata, *bdata, *cdata;
+ bits_word *adata, *bdata, *destdata;
ptrdiff_t i = 0;
ptrdiff_t nr_words;
- CHECK_BOOL_VECTOR (op1);
- CHECK_BOOL_VECTOR (op2);
+ CHECK_BOOL_VECTOR (a);
+ CHECK_BOOL_VECTOR (b);
- nr_bits = bool_vector_size (op1);
- if (bool_vector_size (op2) != nr_bits)
- wrong_length_argument (op1, op2, dest);
+ nr_bits = bool_vector_size (a);
+ if (bool_vector_size (b) != nr_bits)
+ wrong_length_argument (a, b, dest);
nr_words = bool_vector_words (nr_bits);
- bdata = bool_vector_data (op1);
- cdata = bool_vector_data (op2);
+ adata = bool_vector_data (a);
+ bdata = bool_vector_data (b);
if (NILP (dest))
{
dest = make_uninit_bool_vector (nr_bits);
- adata = bool_vector_data (dest);
+ destdata = bool_vector_data (dest);
}
else
{
CHECK_BOOL_VECTOR (dest);
- adata = bool_vector_data (dest);
+ destdata = bool_vector_data (dest);
if (bool_vector_size (dest) != nr_bits)
- wrong_length_argument (op1, op2, dest);
+ wrong_length_argument (a, b, dest);
switch (op)
{
case bool_vector_exclusive_or:
- while (adata[i] == (bdata[i] ^ cdata[i]))
- if (! (++i < nr_words))
- return Qnil;
+ for (; i < nr_words; i++)
+ if (destdata[i] != (adata[i] ^ bdata[i]))
+ goto set_dest;
break;
case bool_vector_subsetp:
- case bool_vector_union:
- while (adata[i] == (bdata[i] | cdata[i]))
- if (! (++i < nr_words))
+ for (; i < nr_words; i++)
+ if (adata[i] &~ bdata[i])
return Qnil;
+ return Qt;
+
+ case bool_vector_union:
+ for (; i < nr_words; i++)
+ if (destdata[i] != (adata[i] | bdata[i]))
+ goto set_dest;
break;
case bool_vector_intersection:
- while (adata[i] == (bdata[i] & cdata[i]))
- if (! (++i < nr_words))
- return Qnil;
+ for (; i < nr_words; i++)
+ if (destdata[i] != (adata[i] & bdata[i]))
+ goto set_dest;
break;
case bool_vector_set_difference:
- while (adata[i] == (bdata[i] &~ cdata[i]))
- if (! (++i < nr_words))
- return Qnil;
+ for (; i < nr_words; i++)
+ if (destdata[i] != (adata[i] &~ bdata[i]))
+ goto set_dest;
break;
}
+
+ return Qnil;
}
+ set_dest:
switch (op)
{
case bool_vector_exclusive_or:
- do
- adata[i] = bdata[i] ^ cdata[i];
- while (++i < nr_words);
- break;
-
- case bool_vector_subsetp:
+ for (; i < nr_words; i++)
+ destdata[i] = adata[i] ^ bdata[i];
break;
case bool_vector_union:
- do
- adata[i] = bdata[i] | cdata[i];
- while (++i < nr_words);
+ for (; i < nr_words; i++)
+ destdata[i] = adata[i] | bdata[i];
break;
case bool_vector_intersection:
- do
- adata[i] = bdata[i] & cdata[i];
- while (++i < nr_words);
+ for (; i < nr_words; i++)
+ destdata[i] = adata[i] & bdata[i];
break;
case bool_vector_set_difference:
- do
- adata[i] = bdata[i] &~ cdata[i];
- while (++i < nr_words);
+ for (; i < nr_words; i++)
+ destdata[i] = adata[i] &~ bdata[i];
break;
+
+ default:
+ eassume (0);
}
return dest;
return count_trailing_zeros (val);
if (BITS_WORD_MAX == ULONG_MAX)
return count_trailing_zeros_l (val);
- if (BITS_WORD_MAX == ULLONG_MAX)
+ if (BITS_WORD_MAX == ULL_MAX)
return count_trailing_zeros_ll (val);
/* The rest of this code is for the unlikely platform where bits_word differs
count < BITS_PER_BITS_WORD - BITS_PER_ULL;
count += BITS_PER_ULL)
{
- if (val & ULLONG_MAX)
+ if (val & ULL_MAX)
return count + count_trailing_zeros_ll (val);
val = shift_right_ull (val);
}
DEFUN ("bool-vector-subsetp", Fbool_vector_subsetp,
Sbool_vector_subsetp, 2, 2, 0,
- doc: )
+ doc: /* Return t if every t value in A is also t in B, nil otherwise.
+A and B must be bool vectors of the same length. */)
(Lisp_Object a, Lisp_Object b)
{
- /* Like bool_vector_union, but doesn't modify b. */
- return bool_vector_binop_driver (b, a, b, bool_vector_subsetp);
+ return bool_vector_binop_driver (a, b, b, bool_vector_subsetp);
}
DEFUN ("bool-vector-not", Fbool_vector_not,
HCoop / bpt / emacs.git / blobdiff