/* Random utility Lisp functions.
- Copyright (C) 1985-1987, 1993-1995, 1997-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1995, 1997-2013 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <unistd.h>
#include <time.h>
-#include <setjmp.h>
#include <intprops.h>
#endif
#endif /* HAVE_MENUS */
-#ifndef NULL
-#define NULL ((POINTER_TYPE *)0)
-#endif
-
Lisp_Object Qstring_lessp;
static Lisp_Object Qprovide, Qrequire;
static Lisp_Object Qyes_or_no_p_history;
static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
-static int internal_equal (Lisp_Object , Lisp_Object, int, int);
-
-#ifndef HAVE_UNISTD_H
-extern long time ();
-#endif
+static bool internal_equal (Lisp_Object, Lisp_Object, int, bool);
\f
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the argument unchanged. */)
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
doc: /* Return a pseudo-random number.
-All integers representable in Lisp are equally likely.
- On most systems, this is 29 bits' worth.
+All integers representable in Lisp, i.e. between `most-negative-fixnum'
+and `most-positive-fixnum', inclusive, are equally likely.
+
With positive integer LIMIT, return random number in interval [0,LIMIT).
With argument t, set the random number seed from the current time and pid.
-Other values of LIMIT are ignored. */)
+With a string argument, set the seed based on the string's contents.
+Other values of LIMIT are ignored.
+
+See Info node `(elisp)Random Numbers' for more details. */)
(Lisp_Object limit)
{
EMACS_INT val;
- Lisp_Object lispy_val;
- EMACS_UINT denominator;
if (EQ (limit, Qt))
- seed_random (getpid () + time (NULL));
+ init_random ();
+ else if (STRINGP (limit))
+ seed_random (SSDATA (limit), SBYTES (limit));
+
+ val = get_random ();
if (NATNUMP (limit) && XFASTINT (limit) != 0)
- {
- /* Try to take our random number from the higher bits of VAL,
- not the lower, since (says Gentzel) the low bits of `random'
- are less random than the higher ones. We do this by using the
- quotient rather than the remainder. At the high end of the RNG
- it's possible to get a quotient larger than n; discarding
- these values eliminates the bias that would otherwise appear
- when using a large n. */
- denominator = ((EMACS_UINT) 1 << VALBITS) / XFASTINT (limit);
- do
- val = get_random () / denominator;
- while (val >= XFASTINT (limit));
- }
- else
- val = get_random ();
- XSETINT (lispy_val, val);
- return lispy_val;
+ val %= XFASTINT (limit);
+ return make_number (val);
}
\f
/* Heuristic on how many iterations of a tight loop can be safely done
before it's time to do a QUIT. This must be a power of 2. */
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-/* Random data-structure functions */
+/* Random data-structure functions. */
+
+static void
+CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
+{
+ CHECK_TYPE (NILP (x), Qlistp, y);
+}
DEFUN ("length", Flength, Slength, 1, 1, 0,
doc: /* Return the length of vector, list or string SEQUENCE.
DEFUN ("compare-strings", Fcompare_strings, Scompare_strings, 6, 7, 0,
doc: /* Compare the contents of two strings, converting to multibyte if needed.
-In string STR1, skip the first START1 characters and stop at END1.
-In string STR2, skip the first START2 characters and stop at END2.
-END1 and END2 default to the full lengths of the respective strings.
-
-Case is significant in this comparison if IGNORE-CASE is nil.
-Unibyte strings are converted to multibyte for comparison.
+The arguments START1, END1, START2, and END2, if non-nil, are
+positions specifying which parts of STR1 or STR2 to compare. In
+string STR1, compare the part between START1 (inclusive) and END1
+\(exclusive). If START1 is nil, it defaults to 0, the beginning of
+the string; if END1 is nil, it defaults to the length of the string.
+Likewise, in string STR2, compare the part between START2 and END2.
+
+The strings are compared by the numeric values of their characters.
+For instance, STR1 is "less than" STR2 if its first differing
+character has a smaller numeric value. If IGNORE-CASE is non-nil,
+characters are converted to lower-case before comparing them. Unibyte
+strings are converted to multibyte for comparison.
The value is t if the strings (or specified portions) match.
If string STR1 is less, the value is a negative number N;
N - 1 is the number of characters that match at the beginning. */)
(Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
{
- register EMACS_INT end1_char, end2_char;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end1_char, end2_char;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
CHECK_STRING (str1);
CHECK_STRING (str2);
if (! NILP (end2))
CHECK_NATNUM (end2);
- i1 = XINT (start1);
- i2 = XINT (start2);
-
- i1_byte = string_char_to_byte (str1, i1);
- i2_byte = string_char_to_byte (str2, i2);
-
end1_char = SCHARS (str1);
if (! NILP (end1) && end1_char > XINT (end1))
end1_char = XINT (end1);
+ if (end1_char < XINT (start1))
+ args_out_of_range (str1, start1);
end2_char = SCHARS (str2);
if (! NILP (end2) && end2_char > XINT (end2))
end2_char = XINT (end2);
+ if (end2_char < XINT (start2))
+ args_out_of_range (str2, start2);
+
+ i1 = XINT (start1);
+ i2 = XINT (start2);
+
+ i1_byte = string_char_to_byte (str1, i1);
+ i2_byte = string_char_to_byte (str2, i2);
while (i1 < end1_char && i2 < end2_char)
{
Symbols are also allowed; their print names are used instead. */)
(register Lisp_Object s1, Lisp_Object s2)
{
- register EMACS_INT end;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
if (SYMBOLP (s1))
s1 = SYMBOL_NAME (s1);
}
\f
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special);
+ enum Lisp_Type target_type, bool last_special);
/* ARGSUSED */
Lisp_Object
if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
wrong_type_argument (Qsequencep, arg);
- return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
+ return concat (1, &arg, XTYPE (arg), 0);
}
/* This structure holds information of an argument of `concat' that is
struct textprop_rec
{
ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */
- EMACS_INT from; /* refer to ARGS[argnum] (argument string) */
- EMACS_INT to; /* refer to VAL (the target string) */
+ ptrdiff_t from; /* refer to ARGS[argnum] (argument string) */
+ ptrdiff_t to; /* refer to VAL (the target string) */
};
static Lisp_Object
concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special)
+ enum Lisp_Type target_type, bool last_special)
{
Lisp_Object val;
- register Lisp_Object tail;
- register Lisp_Object this;
- EMACS_INT toindex;
- EMACS_INT toindex_byte = 0;
- register EMACS_INT result_len;
- register EMACS_INT result_len_byte;
+ Lisp_Object tail;
+ Lisp_Object this;
+ ptrdiff_t toindex;
+ ptrdiff_t toindex_byte = 0;
+ EMACS_INT result_len;
+ EMACS_INT result_len_byte;
ptrdiff_t argnum;
Lisp_Object last_tail;
Lisp_Object prev;
- int some_multibyte;
+ bool some_multibyte;
/* When we make a multibyte string, we can't copy text properties
while concatenating each string because the length of resulting
string can't be decided until we finish the whole concatenation.
{
/* We must count the number of bytes needed in the string
as well as the number of characters. */
- EMACS_INT i;
+ ptrdiff_t i;
Lisp_Object ch;
int c;
- EMACS_INT this_len_byte;
+ ptrdiff_t this_len_byte;
if (VECTORP (this) || COMPILEDP (this))
for (i = 0; i < len; i++)
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
if (STRING_MULTIBYTE (this))
{
some_multibyte = 1;
- result_len_byte += SBYTES (this);
+ this_len_byte = SBYTES (this);
}
else
- result_len_byte += count_size_as_multibyte (SDATA (this),
- SCHARS (this));
+ this_len_byte = count_size_as_multibyte (SDATA (this),
+ SCHARS (this));
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
+ result_len_byte += this_len_byte;
}
}
result_len += len;
- if (STRING_BYTES_BOUND < result_len)
- string_overflow ();
+ if (MOST_POSITIVE_FIXNUM < result_len)
+ memory_full (SIZE_MAX);
}
if (! some_multibyte)
prev = Qnil;
if (STRINGP (val))
- SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
+ SAFE_NALLOCA (textprops, 1, nargs);
for (argnum = 0; argnum < nargs; argnum++)
{
Lisp_Object thislen;
- EMACS_INT thisleni = 0;
- register EMACS_INT thisindex = 0;
- register EMACS_INT thisindex_byte = 0;
+ ptrdiff_t thisleni = 0;
+ register ptrdiff_t thisindex = 0;
+ register ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
if (STRINGP (this) && STRINGP (val)
&& STRING_MULTIBYTE (this) == some_multibyte)
{
- EMACS_INT thislen_byte = SBYTES (this);
+ ptrdiff_t thislen_byte = SBYTES (this);
memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
if (num_textprops > 0)
{
Lisp_Object props;
- EMACS_INT last_to_end = -1;
+ ptrdiff_t last_to_end = -1;
for (argnum = 0; argnum < num_textprops; argnum++)
{
}
\f
static Lisp_Object string_char_byte_cache_string;
-static EMACS_INT string_char_byte_cache_charpos;
-static EMACS_INT string_char_byte_cache_bytepos;
+static ptrdiff_t string_char_byte_cache_charpos;
+static ptrdiff_t string_char_byte_cache_bytepos;
void
clear_string_char_byte_cache (void)
/* Return the byte index corresponding to CHAR_INDEX in STRING. */
-EMACS_INT
-string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
+ptrdiff_t
+string_char_to_byte (Lisp_Object string, ptrdiff_t char_index)
{
- EMACS_INT i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
\f
/* Return the character index corresponding to BYTE_INDEX in STRING. */
-EMACS_INT
-string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
+ptrdiff_t
+string_byte_to_char (Lisp_Object string, ptrdiff_t byte_index)
{
- EMACS_INT i, i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
string_make_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
if (nbytes == SBYTES (string))
return string;
- SAFE_ALLOCA (buf, unsigned char *, nbytes);
+ buf = SAFE_ALLOCA (nbytes);
copy_text (SDATA (string), buf, SBYTES (string),
0, 1);
string_to_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
if (nbytes == SBYTES (string))
return make_multibyte_string (SSDATA (string), nbytes, nbytes);
- SAFE_ALLOCA (buf, unsigned char *, nbytes);
+ buf = SAFE_ALLOCA (nbytes);
memcpy (buf, SDATA (string), SBYTES (string));
str_to_multibyte (buf, nbytes, SBYTES (string));
Lisp_Object
string_make_unibyte (Lisp_Object string)
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
unsigned char *buf;
Lisp_Object ret;
USE_SAFE_ALLOCA;
nchars = SCHARS (string);
- SAFE_ALLOCA (buf, unsigned char *, nchars);
+ buf = SAFE_ALLOCA (nchars);
copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
if (STRING_MULTIBYTE (string))
{
- EMACS_INT bytes = SBYTES (string);
- unsigned char *str = (unsigned char *) xmalloc (bytes);
+ ptrdiff_t bytes = SBYTES (string);
+ unsigned char *str = xmalloc (bytes);
memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
if (! STRING_MULTIBYTE (string))
{
Lisp_Object new_string;
- EMACS_INT nchars, nbytes;
+ ptrdiff_t nchars, nbytes;
parse_str_as_multibyte (SDATA (string),
SBYTES (string),
str_as_multibyte (SDATA (new_string), nbytes,
SBYTES (string), NULL);
string = new_string;
- STRING_SET_INTERVALS (string, NULL_INTERVAL);
+ set_string_intervals (string, NULL);
}
return string;
}
if (STRING_MULTIBYTE (string))
{
- EMACS_INT chars = SCHARS (string);
- unsigned char *str = (unsigned char *) xmalloc (chars);
- EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
+ ptrdiff_t chars = SCHARS (string);
+ unsigned char *str = xmalloc (chars);
+ ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars);
if (converted < chars)
- error ("Can't convert the %"pI"dth character to unibyte", converted);
+ error ("Can't convert the %"pD"dth character to unibyte", converted);
string = make_unibyte_string ((char *) str, chars);
xfree (str);
}
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
Lisp_Object res;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte = 0, to_byte = 0;
CHECK_VECTOR_OR_STRING (string);
CHECK_NUMBER (from);
if (STRINGP (string))
- {
- size = SCHARS (string);
- size_byte = SBYTES (string);
- }
+ size = SCHARS (string);
else
size = ASIZE (string);
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- if (STRINGP (string))
- to_byte = string_char_to_byte (string, to_char);
}
from_char = XINT (from);
if (from_char < 0)
from_char += size;
- if (STRINGP (string))
- from_byte = string_char_to_byte (string, from_char);
-
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
if (STRINGP (string))
{
+ ptrdiff_t to_byte =
+ (NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char));
+ ptrdiff_t from_byte = string_char_to_byte (string, from_char);
res = make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to_char - from_char, &AREF (string, from_char));
+ res = Fvector (to_char - from_char, aref_addr (string, from_char));
return res;
}
With one argument, just copy STRING without its properties. */)
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
- EMACS_INT size, size_byte;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte, to_byte;
+ ptrdiff_t from_byte, to_byte;
CHECK_STRING (string);
size = SCHARS (string);
- size_byte = SBYTES (string);
if (NILP (from))
- from_char = from_byte = 0;
+ from_char = 0;
else
{
CHECK_NUMBER (from);
from_char = XINT (from);
if (from_char < 0)
from_char += size;
-
- from_byte = string_char_to_byte (string, from_char);
}
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
-
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- to_byte = string_char_to_byte (string, to_char);
}
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
+ from_byte = NILP (from) ? 0 : string_char_to_byte (string, from_char);
+ to_byte =
+ NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char);
return make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
both in characters and in bytes. */
Lisp_Object
-substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte)
+substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte)
{
Lisp_Object res;
- EMACS_INT size;
+ ptrdiff_t size;
CHECK_VECTOR_OR_STRING (string);
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to - from, &AREF (string, from));
+ res = Fvector (to - from, aref_addr (string, from));
return res;
}
}
\f
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `eq'.
-If the first member of LIST is ELT, there is no way to remove it by side effect;
-therefore, write `(setq foo (delq element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of LIST which are `eq' to ELT, and return the result.
+More precisely, this function skips any members `eq' to ELT at the
+front of LIST, then removes members `eq' to ELT from the remaining
+sublist by modifying its list structure, then returns the resulting
+list.
+
+Write `(setq foo (delq element foo))' to be sure of correctly changing
+the value of a list `foo'. */)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail, prev;
tail = list;
prev = Qnil;
- while (!NILP (tail))
+ while (CONSP (tail))
{
CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
}
DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of SEQ.
-SEQ must be a list, a vector, or a string.
-The modified SEQ is returned. Comparison is done with `equal'.
-If SEQ is not a list, or the first member of SEQ is ELT, deleting it
-is not a side effect; it is simply using a different sequence.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of SEQ which are `equal' to ELT, and return the result.
+SEQ must be a sequence (i.e. a list, a vector, or a string).
+The return value is a sequence of the same type.
+
+If SEQ is a list, this behaves like `delq', except that it compares
+with `equal' instead of `eq'. In particular, it may remove elements
+by altering the list structure.
+
+If SEQ is not a list, deletion is never performed destructively;
+instead this function creates and returns a new vector or string.
+
+Write `(setq foo (delete element foo))' to be sure of correctly
+changing the value of a sequence `foo'. */)
(Lisp_Object elt, Lisp_Object seq)
{
if (VECTORP (seq))
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
}
else if (STRINGP (seq))
{
- EMACS_INT i, ibyte, nchars, nbytes, cbytes;
+ ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
for (i = nchars = nbytes = ibyte = 0;
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
- EMACS_INT n;
+ ptrdiff_t n;
++nchars;
nbytes += cbytes;
DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
doc: /* Reverse LIST by modifying cdr pointers.
-Return the reversed list. */)
+Return the reversed list. Expects a properly nil-terminated list. */)
(Lisp_Object list)
{
register Lisp_Object prev, tail, next;
while (!NILP (tail))
{
QUIT;
- CHECK_LIST_CONS (tail, list);
+ CHECK_LIST_CONS (tail, tail);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
halftail = XCDR (halftail);
if (EQ (tail, halftail))
break;
-
-#if 0 /* Unsafe version. */
- /* This function can be called asynchronously
- (setup_coding_system). Don't QUIT in that case. */
- if (!interrupt_input_blocked)
- QUIT;
-#endif
}
return Qnil;
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist
- = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
+ set_symbol_plist
+ (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value));
return value;
}
\f
/* DEPTH is current depth of recursion. Signal an error if it
gets too deep.
- PROPS, if non-nil, means compare string text properties too. */
+ PROPS means compare string text properties too. */
-static int
-internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props)
+static bool
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
{
if (depth > 200)
error ("Stack overflow in equal");
d1 = extract_float (o1);
d2 = extract_float (o2);
/* If d is a NaN, then d != d. Two NaNs should be `equal' even
- though they are not =. */
+ though they are not =. */
return d1 == d2 || (d1 != d1 && d2 != d2);
}
case Lisp_Vectorlike:
{
register int i;
- EMACS_INT size = ASIZE (o1);
+ ptrdiff_t size = ASIZE (o1);
/* Pseudovectors have the type encoded in the size field, so this test
actually checks that the objects have the same type as well as the
same size. */
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
- if (!(size & (PVEC_COMPILED
- | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
+ if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ < PVEC_COMPILED)
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
- register EMACS_INT size, idx;
+ register ptrdiff_t size, idx;
if (VECTORP (array))
- {
- register Lisp_Object *p = XVECTOR (array)->contents;
- size = ASIZE (array);
- for (idx = 0; idx < size; idx++)
- p[idx] = item;
- }
+ for (idx = 0, size = ASIZE (array); idx < size; idx++)
+ ASET (array, idx, item);
else if (CHAR_TABLE_P (array))
{
int i;
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (array)->contents[i] = item;
- XCHAR_TABLE (array)->defalt = item;
+ set_char_table_contents (array, i, item);
+ set_char_table_defalt (array, item);
}
else if (STRINGP (array))
{
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
- EMACS_INT size_byte = SBYTES (array);
+ ptrdiff_t size_byte = SBYTES (array);
if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
|| SCHARS (array) * len != size_byte)
else if (BOOL_VECTOR_P (array))
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
- EMACS_INT size_in_chars;
- size = XBOOL_VECTOR (array)->size;
- size_in_chars
- = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ size =
+ ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
- if (size_in_chars)
+ if (size)
{
- memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+ memset (p, ! NILP (item) ? -1 : 0, size);
/* Clear any extraneous bits in the last byte. */
- p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ p[size - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
}
}
else
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- EMACS_INT len;
+ ptrdiff_t len;
CHECK_STRING (string);
len = SBYTES (string);
memset (SDATA (string), 0, len);
}
else if (STRINGP (seq))
{
- EMACS_INT i_byte;
+ ptrdiff_t i_byte;
for (i = 0, i_byte = 0; i < leni;)
{
int c;
- EMACS_INT i_before = i;
+ ptrdiff_t i_before = i;
FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
XSETFASTINT (dummy, c);
{
Lisp_Object len;
register EMACS_INT leni;
- ptrdiff_t i, nargs;
+ EMACS_INT nargs;
+ ptrdiff_t i;
register Lisp_Object *args;
struct gcpro gcpro1;
Lisp_Object ret;
CHECK_STRING (prompt);
#ifdef HAVE_MENUS
- if (FRAME_WINDOW_P (SELECTED_FRAME ())
- && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
- && have_menus_p ())
+ && window_system_available (SELECTED_FRAME ()))
{
Lisp_Object pane, menu, obj;
redisplay_preserve_echo_area (4);
Fding (Qnil);
Fdiscard_input ();
- message ("Please answer yes or no.");
+ message1 ("Please answer yes or no.");
Fsleep_for (make_number (2), Qnil);
}
}
return (NILP (tem)) ? Qnil : Qt;
}
+static Lisp_Object Qfuncall;
+
DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0,
doc: /* Announce that FEATURE is a feature of the current Emacs.
The optional argument SUBFEATURES should be a list of symbols listing
/* Run any load-hooks for this file. */
tem = Fassq (feature, Vafter_load_alist);
if (CONSP (tem))
- Fprogn (XCDR (tem));
+ Fmapc (Qfuncall, XCDR (tem));
return feature;
}
If FILENAME is omitted, the printname of FEATURE is used as the file name,
and `load' will try to load this name appended with the suffix `.elc' or
`.el', in that order. The name without appended suffix will not be used.
-If your system supports it, `.el.gz' files will also be considered.
+See `get-load-suffixes' for the complete list of suffixes.
If the optional third argument NOERROR is non-nil,
then return nil if the file is not found instead of signaling an error.
Normally the return value is FEATURE.
The normal messages at start and end of loading FILENAME are suppressed. */)
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
- register Lisp_Object tem;
+ Lisp_Object tem;
struct gcpro gcpro1, gcpro2;
- int from_file = load_in_progress;
+ bool from_file = load_in_progress;
CHECK_SYMBOL (feature);
if (NILP (tem))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int nesting = 0;
/* This is to make sure that loadup.el gives a clear picture
usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- /* This function can GC. */
+ /* This function can GC. */
Lisp_Object newargs[3];
struct gcpro gcpro1, gcpro2;
Lisp_Object result;
for (i = 0; i < 7; i++)
{
str = nl_langinfo (days[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
/* Fixme: Is this coding system necessarily right, even if
it is consistent with CODESET? If not, what to do? */
- Faset (v, make_number (i),
- code_convert_string_norecord (val, Vlocale_coding_system,
- 0));
+ ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
+ 0));
}
UNGCPRO;
return v;
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
- val = make_unibyte_string (str, strlen (str));
- Faset (v, make_number (i),
- code_convert_string_norecord (val, Vlocale_coding_system, 0));
+ val = build_unibyte_string (str);
+ ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
+ 0));
}
UNGCPRO;
return v;
but is in the locale files. This could be used by ps-print. */
#ifdef PAPER_WIDTH
else if (EQ (item, Qpaper))
- {
- return list2 (make_number (nl_langinfo (PAPER_WIDTH)),
- make_number (nl_langinfo (PAPER_HEIGHT)));
- }
+ return list2i (nl_langinfo (PAPER_WIDTH), nl_langinfo (PAPER_HEIGHT));
#endif /* PAPER_WIDTH */
#endif /* HAVE_LANGINFO_CODESET*/
return Qnil;
base64 characters. */
-static EMACS_INT base64_encode_1 (const char *, char *, EMACS_INT, int, int);
-static EMACS_INT base64_decode_1 (const char *, char *, EMACS_INT, int,
- EMACS_INT *);
+static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool);
+static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
+ ptrdiff_t *);
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
2, 3, "r",
(Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
{
char *encoded;
- EMACS_INT allength, length;
- EMACS_INT ibeg, iend, encoded_length;
- EMACS_INT old_pos = PT;
+ ptrdiff_t allength, length;
+ ptrdiff_t ibeg, iend, encoded_length;
+ ptrdiff_t old_pos = PT;
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
allength = length + length/3 + 1;
allength += allength / MIME_LINE_LENGTH + 1 + 6;
- SAFE_ALLOCA (encoded, char *, allength);
+ encoded = SAFE_ALLOCA (allength);
encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
encoded, length, NILP (no_line_break),
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
into shorter lines. */)
(Lisp_Object string, Lisp_Object no_line_break)
{
- EMACS_INT allength, length, encoded_length;
+ ptrdiff_t allength, length, encoded_length;
char *encoded;
Lisp_Object encoded_string;
USE_SAFE_ALLOCA;
allength += allength / MIME_LINE_LENGTH + 1 + 6;
/* We need to allocate enough room for decoding the text. */
- SAFE_ALLOCA (encoded, char *, allength);
+ encoded = SAFE_ALLOCA (allength);
encoded_length = base64_encode_1 (SSDATA (string),
encoded, length, NILP (no_line_break),
STRING_MULTIBYTE (string));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
return encoded_string;
}
-static EMACS_INT
-base64_encode_1 (const char *from, char *to, EMACS_INT length,
- int line_break, int multibyte)
+static ptrdiff_t
+base64_encode_1 (const char *from, char *to, ptrdiff_t length,
+ bool line_break, bool multibyte)
{
int counter = 0;
- EMACS_INT i = 0;
+ ptrdiff_t i = 0;
char *e = to;
int c;
unsigned int value;
If the region can't be decoded, signal an error and don't modify the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
- EMACS_INT ibeg, iend, length, allength;
+ ptrdiff_t ibeg, iend, length, allength;
char *decoded;
- EMACS_INT old_pos = PT;
- EMACS_INT decoded_length;
- EMACS_INT inserted_chars;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t old_pos = PT;
+ ptrdiff_t decoded_length;
+ ptrdiff_t inserted_chars;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
working on a multibyte buffer, each decoded code may occupy at
most two bytes. */
allength = multibyte ? length * 2 : length;
- SAFE_ALLOCA (decoded, char *, allength);
+ decoded = SAFE_ALLOCA (allength);
move_gap_both (XFASTINT (beg), ibeg);
decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
decoded, length,
multibyte, &inserted_chars);
if (decoded_length > allength)
- abort ();
+ emacs_abort ();
if (decoded_length < 0)
{
(Lisp_Object string)
{
char *decoded;
- EMACS_INT length, decoded_length;
+ ptrdiff_t length, decoded_length;
Lisp_Object decoded_string;
USE_SAFE_ALLOCA;
length = SBYTES (string);
/* We need to allocate enough room for decoding the text. */
- SAFE_ALLOCA (decoded, char *, length);
+ decoded = SAFE_ALLOCA (length);
/* The decoded result should be unibyte. */
decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
0, NULL);
if (decoded_length > length)
- abort ();
+ emacs_abort ();
else if (decoded_length >= 0)
decoded_string = make_unibyte_string (decoded, decoded_length);
else
return decoded_string;
}
-/* Base64-decode the data at FROM of LENGHT bytes into TO. If
- MULTIBYTE is nonzero, the decoded result should be in multibyte
- form. If NCHARS_RETRUN is not NULL, store the number of produced
+/* Base64-decode the data at FROM of LENGTH bytes into TO. If
+ MULTIBYTE, the decoded result should be in multibyte
+ form. If NCHARS_RETURN is not NULL, store the number of produced
characters in *NCHARS_RETURN. */
-static EMACS_INT
-base64_decode_1 (const char *from, char *to, EMACS_INT length,
- int multibyte, EMACS_INT *nchars_return)
+static ptrdiff_t
+base64_decode_1 (const char *from, char *to, ptrdiff_t length,
+ bool multibyte, ptrdiff_t *nchars_return)
{
- EMACS_INT i = 0; /* Used inside READ_QUADRUPLET_BYTE */
+ ptrdiff_t i = 0; /* Used inside READ_QUADRUPLET_BYTE */
char *e = to;
unsigned char c;
unsigned long value;
- EMACS_INT nchars = 0;
+ ptrdiff_t nchars = 0;
while (1)
{
/* Various symbols. */
-static Lisp_Object Qhash_table_p, Qkey, Qvalue;
-Lisp_Object Qeq, Qeql, Qequal;
+static Lisp_Object Qhash_table_p;
+static Lisp_Object Qkey, Qvalue, Qeql;
+Lisp_Object Qeq, Qequal;
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
-/* Function prototypes. */
-
-static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
-static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *);
-static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
-static int sweep_weak_table (struct Lisp_Hash_Table *, int);
-
-
\f
/***********************************************************************
Utilities
***********************************************************************/
+static void
+CHECK_HASH_TABLE (Lisp_Object x)
+{
+ CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x);
+}
+
+static void
+set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
+{
+ h->key_and_value = key_and_value;
+}
+static void
+set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
+{
+ h->next = next;
+}
+static void
+set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->next, idx, val);
+}
+static void
+set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
+{
+ h->hash = hash;
+}
+static void
+set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->hash, idx, val);
+}
+static void
+set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
+{
+ h->index = index;
+}
+static void
+set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->index, idx, val);
+}
+
/* If OBJ is a Lisp hash table, return a pointer to its struct
Lisp_Hash_Table. Otherwise, signal an error. */
/* Value is the next integer I >= N, N >= 0 which is "almost" a prime
- number. */
+ number. A number is "almost" a prime number if it is not divisible
+ by any integer in the range 2 .. (NEXT_ALMOST_PRIME_LIMIT - 1). */
EMACS_INT
next_almost_prime (EMACS_INT n)
{
+ verify (NEXT_ALMOST_PRIME_LIMIT == 11);
for (n |= 1; ; n += 2)
if (n % 3 != 0 && n % 5 != 0 && n % 7 != 0)
return n;
/* Return a Lisp vector which has the same contents as VEC but has
- size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting
- vector that are not copied from VEC are set to INIT. */
+ at least INCR_MIN more entries, where INCR_MIN is positive.
+ If NITEMS_MAX is not -1, do not grow the vector to be any larger
+ than NITEMS_MAX. Entries in the resulting
+ vector that are not copied from VEC are set to nil. */
Lisp_Object
-larger_vector (Lisp_Object vec, EMACS_INT new_size, Lisp_Object init)
+larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
- EMACS_INT i, old_size;
-
- xassert (VECTORP (vec));
+ ptrdiff_t i, incr, incr_max, old_size, new_size;
+ ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / sizeof *v->contents;
+ ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
+ ? nitems_max : C_language_max);
+ eassert (VECTORP (vec));
+ eassert (0 < incr_min && -1 <= nitems_max);
old_size = ASIZE (vec);
- xassert (new_size >= old_size);
-
+ incr_max = n_max - old_size;
+ incr = max (incr_min, min (old_size >> 1, incr_max));
+ if (incr_max < incr)
+ memory_full (SIZE_MAX);
+ new_size = old_size + incr;
v = allocate_vector (new_size);
memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
for (i = old_size; i < new_size; ++i)
- v->contents[i] = init;
+ v->contents[i] = Qnil;
XSETVECTOR (vec, v);
return vec;
}
Low-level Functions
***********************************************************************/
+static struct hash_table_test hashtest_eq;
+struct hash_table_test hashtest_eql, hashtest_equal;
+
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */
-static int
-cmpfn_eql (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_eql (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
return (FLOATP (key1)
&& FLOATP (key2)
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `equal'. Value is true if KEY1 and
KEY2 are the same. */
-static int
-cmpfn_equal (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_equal (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- return hash1 == hash2 && !NILP (Fequal (key1, key2));
+ return !NILP (Fequal (key1, key2));
}
/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code
- HASH2 in hash table H using H->user_cmp_function. Value is non-zero
+ HASH2 in hash table H using H->user_cmp_function. Value is true
if KEY1 and KEY2 are the same. */
-static int
-cmpfn_user_defined (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_user_defined (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- if (hash1 == hash2)
- {
- Lisp_Object args[3];
+ Lisp_Object args[3];
- args[0] = h->user_cmp_function;
- args[1] = key1;
- args[2] = key2;
- return !NILP (Ffuncall (3, args));
- }
- else
- return 0;
+ args[0] = ht->user_cmp_function;
+ args[1] = key1;
+ args[2] = key2;
+ return !NILP (Ffuncall (3, args));
}
in a Lisp integer. */
static EMACS_UINT
-hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ EMACS_UINT hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash;
if (FLOATP (key))
hash = sxhash (key, 0);
else
- hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash = sxhash (key, 0);
- xassert ((hash & ~INTMASK) == 0);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses as
user-defined function to compare keys. The hash code returned is
guaranteed to fit in a Lisp integer. */
static EMACS_UINT
-hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
{
Lisp_Object args[2], hash;
- args[0] = h->user_hash_function;
+ args[0] = ht->user_hash_function;
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
return XUINT (hash);
}
+/* An upper bound on the size of a hash table index. It must fit in
+ ptrdiff_t and be a valid Emacs fixnum. */
+#define INDEX_SIZE_BOUND \
+ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX / word_size))
/* Create and initialize a new hash table.
one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
Lisp_Object
-make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
- Lisp_Object rehash_threshold, Lisp_Object weak,
- Lisp_Object user_test, Lisp_Object user_hash)
+make_hash_table (struct hash_table_test test,
+ Lisp_Object size, Lisp_Object rehash_size,
+ Lisp_Object rehash_threshold, Lisp_Object weak)
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
- EMACS_INT index_size, i, sz;
+ EMACS_INT index_size, sz;
+ ptrdiff_t i;
double index_float;
/* Preconditions. */
- xassert (SYMBOLP (test));
- xassert (INTEGERP (size) && XINT (size) >= 0);
- xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
+ eassert (SYMBOLP (test.name));
+ eassert (INTEGERP (size) && XINT (size) >= 0);
+ eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
- xassert (FLOATP (rehash_threshold)
+ eassert (FLOATP (rehash_threshold)
&& 0 < XFLOAT_DATA (rehash_threshold)
&& XFLOAT_DATA (rehash_threshold) <= 1.0);
sz = XFASTINT (size);
index_float = sz / XFLOAT_DATA (rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
- if (MOST_POSITIVE_FIXNUM < max (index_size, 2 * sz))
+ : INDEX_SIZE_BOUND + 1);
+ if (INDEX_SIZE_BOUND < max (index_size, 2 * sz))
error ("Hash table too large");
/* Allocate a table and initialize it. */
/* Initialize hash table slots. */
h->test = test;
- if (EQ (test, Qeql))
- {
- h->cmpfn = cmpfn_eql;
- h->hashfn = hashfn_eql;
- }
- else if (EQ (test, Qeq))
- {
- h->cmpfn = NULL;
- h->hashfn = hashfn_eq;
- }
- else if (EQ (test, Qequal))
- {
- h->cmpfn = cmpfn_equal;
- h->hashfn = hashfn_equal;
- }
- else
- {
- h->user_cmp_function = user_test;
- h->user_hash_function = user_hash;
- h->cmpfn = cmpfn_user_defined;
- h->hashfn = hashfn_user_defined;
- }
-
h->weak = weak;
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next_slot (h, i, make_number (i + 1));
h->next_free = make_number (0);
XSET_HASH_TABLE (table, h);
- xassert (HASH_TABLE_P (table));
- xassert (XHASH_TABLE (table) == h);
+ eassert (HASH_TABLE_P (table));
+ eassert (XHASH_TABLE (table) == h);
/* Maybe add this hash table to the list of all weak hash tables. */
if (NILP (h->weak))
{
Lisp_Object table;
struct Lisp_Hash_Table *h2;
- struct Lisp_Vector *next;
h2 = allocate_hash_table ();
- next = h2->header.next.vector;
- memcpy (h2, h1, sizeof *h2);
- h2->header.next.vector = next;
+ *h2 = *h1;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
h2->next = Fcopy_sequence (h1->next);
/* Resize hash table H if it's too full. If H cannot be resized
because it's already too large, throw an error. */
-static inline void
+static void
maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
if (NILP (h->next_free))
{
- EMACS_INT old_size = HASH_TABLE_SIZE (h);
- EMACS_INT i, new_size, index_size;
- EMACS_INT nsize;
+ ptrdiff_t old_size = HASH_TABLE_SIZE (h);
+ EMACS_INT new_size, index_size, nsize;
+ ptrdiff_t i;
double index_float;
if (INTEGERP (h->rehash_size))
else
{
double float_new_size = old_size * XFLOAT_DATA (h->rehash_size);
- if (float_new_size < MOST_POSITIVE_FIXNUM + 1)
+ if (float_new_size < INDEX_SIZE_BOUND + 1)
{
new_size = float_new_size;
if (new_size <= old_size)
new_size = old_size + 1;
}
else
- new_size = MOST_POSITIVE_FIXNUM + 1;
+ new_size = INDEX_SIZE_BOUND + 1;
}
index_float = new_size / XFLOAT_DATA (h->rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
+ : INDEX_SIZE_BOUND + 1);
nsize = max (index_size, 2 * new_size);
- if (nsize > MOST_POSITIVE_FIXNUM)
+ if (INDEX_SIZE_BOUND < nsize)
error ("Hash table too large to resize");
- h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
- h->next = larger_vector (h->next, new_size, Qnil);
- h->hash = larger_vector (h->hash, new_size, Qnil);
- h->index = Fmake_vector (make_number (index_size), Qnil);
+#ifdef ENABLE_CHECKING
+ if (HASH_TABLE_P (Vpurify_flag)
+ && XHASH_TABLE (Vpurify_flag) == h)
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("Growing hash table to: %d");
+ args[1] = make_number (new_size);
+ Fmessage (2, args);
+ }
+#endif
+
+ set_hash_key_and_value (h, larger_vector (h->key_and_value,
+ 2 * (new_size - old_size), -1));
+ set_hash_next (h, larger_vector (h->next, new_size - old_size, -1));
+ set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1));
+ set_hash_index (h, Fmake_vector (make_number (index_size), Qnil));
/* Update the free list. Do it so that new entries are added at
the end of the free list. This makes some operations like
maphash faster. */
for (i = old_size; i < new_size - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next_slot (h, i, make_number (i + 1));
if (!NILP (h->next_free))
{
!NILP (next))
last = next;
- HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
+ set_hash_next_slot (h, XFASTINT (last), make_number (old_size));
}
else
XSETFASTINT (h->next_free, old_size);
if (!NILP (HASH_HASH (h, i)))
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
- EMACS_INT start_of_bucket = hash_code % ASIZE (h->index);
- HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
- HASH_INDEX (h, start_of_bucket) = make_number (i);
+ ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
}
}
}
the hash code of KEY. Value is the index of the entry in H
matching KEY, or -1 if not found. */
-EMACS_INT
+ptrdiff_t
hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
{
EMACS_UINT hash_code;
- EMACS_INT start_of_bucket;
+ ptrdiff_t start_of_bucket;
Lisp_Object idx;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
if (hash)
*hash = hash_code;
/* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
break;
idx = HASH_NEXT (h, i);
}
HASH is a previously computed hash code of KEY.
Value is the index of the entry in H matching KEY. */
-EMACS_INT
+ptrdiff_t
hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
EMACS_UINT hash)
{
- EMACS_INT start_of_bucket, i;
+ ptrdiff_t start_of_bucket, i;
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
/* Store key/value in the key_and_value vector. */
i = XFASTINT (h->next_free);
h->next_free = HASH_NEXT (h, i);
- HASH_KEY (h, i) = key;
- HASH_VALUE (h, i) = value;
+ set_hash_key_slot (h, i, key);
+ set_hash_value_slot (h, i, value);
/* Remember its hash code. */
- HASH_HASH (h, i) = make_number (hash);
+ set_hash_hash_slot (h, i, make_number (hash));
/* Add new entry to its collision chain. */
start_of_bucket = hash % ASIZE (h->index);
- HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
- HASH_INDEX (h, start_of_bucket) = make_number (i);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
return i;
}
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;
- EMACS_INT start_of_bucket;
+ ptrdiff_t start_of_bucket;
Lisp_Object idx, prev;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
/* We need not gcpro idx, prev since they're either integers or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
{
/* Take entry out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
+ set_hash_index_slot (h, start_of_bucket, HASH_NEXT (h, i));
else
- HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
+ set_hash_next_slot (h, XFASTINT (prev), HASH_NEXT (h, i));
/* Clear slots in key_and_value and add the slots to
the free list. */
- HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil;
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
+ set_hash_next_slot (h, i, h->next_free);
h->next_free = make_number (i);
h->count--;
- xassert (h->count >= 0);
+ eassert (h->count >= 0);
break;
}
else
{
if (h->count > 0)
{
- EMACS_INT i, size = HASH_TABLE_SIZE (h);
+ ptrdiff_t i, size = HASH_TABLE_SIZE (h);
for (i = 0; i < size; ++i)
{
- HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil;
- HASH_KEY (h, i) = Qnil;
- HASH_VALUE (h, i) = Qnil;
- HASH_HASH (h, i) = Qnil;
+ set_hash_next_slot (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
}
for (i = 0; i < ASIZE (h->index); ++i)
Weak Hash Tables
************************************************************************/
-void
-init_weak_hash_tables (void)
-{
- weak_hash_tables = NULL;
-}
-
-/* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove
+/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove
entries from the table that don't survive the current GC.
- REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
- non-zero if anything was marked. */
+ !REMOVE_ENTRIES_P means mark entries that are in use. Value is
+ true if anything was marked. */
-static int
-sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
+static bool
+sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- EMACS_INT bucket, n;
- int marked;
+ ptrdiff_t bucket, n;
+ bool marked;
n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
marked = 0;
prev = Qnil;
for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
- EMACS_INT i = XFASTINT (idx);
- int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
- int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
- int remove_p;
+ ptrdiff_t i = XFASTINT (idx);
+ bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
+ bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+ bool remove_p;
if (EQ (h->weak, Qkey))
remove_p = !key_known_to_survive_p;
else if (EQ (h->weak, Qkey_and_value))
remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
else
- abort ();
+ emacs_abort ();
next = HASH_NEXT (h, i);
{
/* Take out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, bucket) = next;
+ set_hash_index_slot (h, bucket, next);
else
- HASH_NEXT (h, XFASTINT (prev)) = next;
+ set_hash_next_slot (h, XFASTINT (prev), next);
/* Add to free list. */
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_next_slot (h, i, h->next_free);
h->next_free = idx;
/* Clear key, value, and hash. */
- HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
- HASH_HASH (h, i) = Qnil;
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
h->count--;
}
sweep_weak_hash_tables (void)
{
struct Lisp_Hash_Table *h, *used, *next;
- int marked;
+ bool marked;
/* Mark all keys and values that are in use. Keep on marking until
there is no more change. This is necessary for cases like
#define SXHASH_MAX_LEN 7
-/* Combine two integers X and Y for hashing. The result might not fit
- into a Lisp integer. */
-
-#define SXHASH_COMBINE(X, Y) \
- ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
- + (EMACS_UINT) (Y))
-
-/* Hash X, returning a value that fits into a Lisp integer. */
-#define SXHASH_REDUCE(X) \
- ((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK)
-
-/* Return a hash for string PTR which has length LEN. The hash
- code returned is guaranteed to fit in a Lisp integer. */
+/* Return a hash for string PTR which has length LEN. The hash value
+ can be any EMACS_UINT value. */
-static EMACS_UINT
-sxhash_string (unsigned char *ptr, EMACS_INT len)
+EMACS_UINT
+hash_string (char const *ptr, ptrdiff_t len)
{
- unsigned char *p = ptr;
- unsigned char *end = p + len;
+ char const *p = ptr;
+ char const *end = p + len;
unsigned char c;
EMACS_UINT hash = 0;
while (p != end)
{
c = *p++;
- if (c >= 0140)
- c -= 40;
- hash = SXHASH_COMBINE (hash, c);
+ hash = sxhash_combine (hash, c);
}
+ return hash;
+}
+
+/* Return a hash for string PTR which has length LEN. The hash
+ code returned is guaranteed to fit in a Lisp integer. */
+
+static EMACS_UINT
+sxhash_string (char const *ptr, ptrdiff_t len)
+{
+ EMACS_UINT hash = hash_string (ptr, len);
return SXHASH_REDUCE (hash);
}
/* Return a hash for the floating point value VAL. */
-static EMACS_INT
+static EMACS_UINT
sxhash_float (double val)
{
EMACS_UINT hash = 0;
u.val = val;
memset (&u.val + 1, 0, sizeof u - sizeof u.val);
for (i = 0; i < WORDS_PER_DOUBLE; i++)
- hash = SXHASH_COMBINE (hash, u.word[i]);
+ hash = sxhash_combine (hash, u.word[i]);
return SXHASH_REDUCE (hash);
}
list = XCDR (list), ++i)
{
EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
if (!NILP (list))
{
EMACS_UINT hash2 = sxhash (list, depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
for (i = 0; i < n; ++i)
{
EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size);
for (i = 0; i < n; ++i)
- hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
+ hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]);
return SXHASH_REDUCE (hash);
}
break;
case Lisp_Misc:
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Symbol:
/* Fall through. */
case Lisp_String:
- hash = sxhash_string (SDATA (obj), SCHARS (obj));
+ hash = sxhash_string (SSDATA (obj), SBYTES (obj));
break;
/* This can be everything from a vector to an overlay. */
else
/* Others are `equal' if they are `eq', so let's take their
address as hash. */
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Cons:
break;
default:
- abort ();
+ emacs_abort ();
}
return hash;
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object test, size, rehash_size, rehash_threshold, weak;
- Lisp_Object user_test, user_hash;
+ struct hash_table_test testdesc;
char *used;
ptrdiff_t i;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
- used = (char *) alloca (nargs * sizeof *used);
+ used = alloca (nargs * sizeof *used);
memset (used, 0, nargs * sizeof *used);
/* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used);
test = i ? args[i] : Qeql;
- if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
+ if (EQ (test, Qeq))
+ testdesc = hashtest_eq;
+ else if (EQ (test, Qeql))
+ testdesc = hashtest_eql;
+ else if (EQ (test, Qequal))
+ testdesc = hashtest_equal;
+ else
{
/* See if it is a user-defined test. */
Lisp_Object prop;
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
signal_error ("Invalid hash table test", test);
- user_test = XCAR (prop);
- user_hash = XCAR (XCDR (prop));
+ testdesc.name = test;
+ testdesc.user_cmp_function = XCAR (prop);
+ testdesc.user_hash_function = XCAR (XCDR (prop));
+ testdesc.hashfn = hashfn_user_defined;
+ testdesc.cmpfn = cmpfn_user_defined;
}
- else
- user_test = user_hash = Qnil;
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
if (!used[i])
signal_error ("Invalid argument list", args[i]);
- return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
- user_test, user_hash);
+ return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
}
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
- return check_hash_table (table)->test;
+ return check_hash_table (table)->test.name;
}
(Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- EMACS_INT i = hash_lookup (h, key, NULL);
+ ptrdiff_t i = hash_lookup (h, key, NULL);
return i >= 0 ? HASH_VALUE (h, i) : dflt;
}
(Lisp_Object key, Lisp_Object value, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- EMACS_INT i;
+ ptrdiff_t i;
EMACS_UINT hash;
i = hash_lookup (h, key, &hash);
if (i >= 0)
- HASH_VALUE (h, i) = value;
+ set_hash_value_slot (h, i, value);
else
hash_put (h, key, value, hash);
{
struct Lisp_Hash_Table *h = check_hash_table (table);
Lisp_Object args[3];
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
{
int i;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT start_char = 0, end_char = 0;
- EMACS_INT start_byte = 0, end_byte = 0;
+ ptrdiff_t start_byte, end_byte;
register EMACS_INT b, e;
register struct buffer *bp;
EMACS_INT temp;
object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
size = SCHARS (object);
- size_byte = SBYTES (object);
if (!NILP (start))
{
if (start_char < 0)
start_char += size;
-
- start_byte = string_char_to_byte (object, start_char);
}
if (NILP (end))
- {
- end_char = size;
- end_byte = size_byte;
- }
+ end_char = size;
else
{
CHECK_NUMBER (end);
if (end_char < 0)
end_char += size;
-
- end_byte = string_char_to_byte (object, end_char);
}
if (!(0 <= start_char && start_char <= end_char && end_char <= size))
args_out_of_range_3 (object, make_number (start_char),
make_number (end_char));
+
+ start_byte = NILP (start) ? 0 : string_char_to_byte (object, start_char);
+ end_byte =
+ NILP (end) ? SBYTES (object) : string_char_to_byte (object, end_char);
}
else
{
struct buffer *prev = current_buffer;
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
CHECK_BUFFER (object);
bp = XBUFFER (object);
- if (bp != current_buffer)
- set_buffer_internal (bp);
+ set_buffer_internal (bp);
if (NILP (start))
b = BEGV;
coding_system = Vcoding_system_for_write;
else
{
- int force_raw_text = 0;
+ bool force_raw_text = 0;
coding_system = BVAR (XBUFFER (object), buffer_file_coding_system);
if (NILP (coding_system)
force_raw_text = 1;
}
- if (NILP (coding_system) && !NILP (Fbuffer_file_name(object)))
+ if (NILP (coding_system) && !NILP (Fbuffer_file_name (object)))
{
/* Check file-coding-system-alist. */
Lisp_Object args[4], val;
args[0] = Qwrite_region; args[1] = start; args[2] = end;
- args[3] = Fbuffer_file_name(object);
+ args[3] = Fbuffer_file_name (object);
val = Ffind_operation_coding_system (4, args);
if (CONSP (val) && !NILP (XCDR (val)))
coding_system = XCDR (val);
}
object = make_buffer_string (b, e, 0);
- if (prev != current_buffer)
- set_buffer_internal (prev);
+ set_buffer_internal (prev);
/* Discard the unwind protect for recovering the current
buffer. */
specpdl_ptr--;
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
+ start_byte = 0;
+ end_byte = SBYTES (object);
}
if (EQ (algorithm, Qmd5))
digest = make_uninit_string (digest_size * 2);
hash_func (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
+ end_byte - start_byte,
SSDATA (digest));
if (NILP (binary))
}
DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0,
- doc: /* Return the secure hash of an OBJECT.
-ALGORITHM is a symbol: md5, sha1, sha224, sha256, sha384 or sha512.
-OBJECT is either a string or a buffer.
-Optional arguments START and END are character positions specifying
-which portion of OBJECT for computing the hash. If BINARY is non-nil,
-return a string in binary form. */)
+ doc: /* Return the secure hash of OBJECT, a buffer or string.
+ALGORITHM is a symbol specifying the hash to use:
+md5, sha1, sha224, sha256, sha384 or sha512.
+
+The two optional arguments START and END are positions specifying for
+which part of OBJECT to compute the hash. If nil or omitted, uses the
+whole OBJECT.
+
+If BINARY is non-nil, returns a string in binary form. */)
(Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
{
return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
DEFSYM (Qsubfeatures, "subfeatures");
+ DEFSYM (Qfuncall, "funcall");
#ifdef HAVE_LANGINFO_CODESET
DEFSYM (Qcodeset, "codeset");
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
- doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
+ doc: /* Non-nil means mouse commands use dialog boxes to ask questions.
This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
invoked by mouse clicks and mouse menu items.
use_dialog_box = 1;
DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
- doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
+ doc: /* Non-nil means mouse commands use a file dialog to ask for files.
This applies to commands from menus and tool bar buttons even when
they are initiated from the keyboard. If `use-dialog-box' is nil,
that disables the use of a file dialog, regardless of the value of
defsubr (&Smd5);
defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
-}
-
-void
-init_fns (void)
-{
+ {
+ struct hash_table_test
+ eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq },
+ eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql },
+ equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal };
+ hashtest_eq = eq;
+ hashtest_eql = eql;
+ hashtest_equal = equal;
+ }
}