summaryrefslogtreecommitdiff
path: root/src/fns.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/fns.c')
-rw-r--r--src/fns.c279
1 files changed, 134 insertions, 145 deletions
diff --git a/src/fns.c b/src/fns.c
index 392196e2c7a..b2f84b202de 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,6 +47,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
+static EMACS_UINT sxhash_obj (Lisp_Object, int);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the ARGUMENT unchanged. */
@@ -225,12 +226,12 @@ Letter-case is significant, but text properties are ignored. */)
for (x = 1; x <= len2; x++)
{
column[0] = x;
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
+ c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
i1 = i1_byte = 0;
for (y = 1, lastdiag = x - 1; y <= len1; y++)
{
olddiag = column[y];
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+ c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
column[y] = min (min (column[y] + 1, column[y-1] + 1),
lastdiag + (c1 == c2 ? 0 : 1));
lastdiag = olddiag;
@@ -311,10 +312,8 @@ If string STR1 is greater, the value is a positive number N;
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte);
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte);
+ int c1 = fetch_string_char_as_multibyte_advance (str1, &i1, &i1_byte);
+ int c2 = fetch_string_char_as_multibyte_advance (str2, &i2, &i2_byte);
if (c1 == c2)
continue;
@@ -349,11 +348,8 @@ DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead. */)
- (register Lisp_Object string1, Lisp_Object string2)
+ (Lisp_Object string1, Lisp_Object string2)
{
- register ptrdiff_t end;
- register ptrdiff_t i1, i1_byte, i2, i2_byte;
-
if (SYMBOLP (string1))
string1 = SYMBOL_NAME (string1);
if (SYMBOLP (string2))
@@ -361,21 +357,15 @@ Symbols are also allowed; their print names are used instead. */)
CHECK_STRING (string1);
CHECK_STRING (string2);
- i1 = i1_byte = i2 = i2_byte = 0;
-
- end = SCHARS (string1);
- if (end > SCHARS (string2))
- end = SCHARS (string2);
+ ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
+ ptrdiff_t end = min (SCHARS (string1), SCHARS (string2));
while (i1 < end)
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
-
+ int c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
+ int c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
@@ -766,8 +756,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
Lisp_Object thislen;
ptrdiff_t thisleni = 0;
- register ptrdiff_t thisindex = 0;
- register ptrdiff_t thisindex_byte = 0;
+ ptrdiff_t thisindex = 0;
+ ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
@@ -820,9 +810,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
int c;
if (STRING_MULTIBYTE (this))
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
- thisindex,
- thisindex_byte);
+ c = fetch_string_char_advance_no_check (this, &thisindex,
+ &thisindex_byte);
else
{
c = SREF (this, thisindex); thisindex++;
@@ -1960,9 +1949,7 @@ See also the function `nreverse', which is used more often. */)
p = SDATA (seq), q = SDATA (new) + bytes;
while (q > SDATA (new))
{
- int ch, len;
-
- ch = STRING_CHAR_AND_LENGTH (p, len);
+ int len, ch = string_char_and_length (p, &len);
p += len, q -= len;
CHAR_STRING (ch, q);
}
@@ -2433,6 +2420,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
same size. */
if (ASIZE (o2) != size)
return false;
+
+ /* Compare bignums, overlays, markers, and boolvectors
+ specially, by comparing their values. */
if (BIGNUMP (o1))
return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
if (OVERLAYP (o1))
@@ -2453,21 +2443,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
&& (XMARKER (o1)->buffer == 0
|| XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
}
- /* Boolvectors are compared much like strings. */
if (BOOL_VECTOR_P (o1))
{
EMACS_INT size = bool_vector_size (o1);
- if (size != bool_vector_size (o2))
- return false;
- if (memcmp (bool_vector_data (o1), bool_vector_data (o2),
- bool_vector_bytes (size)))
- return false;
- return true;
- }
- if (WINDOW_CONFIGURATIONP (o1))
- {
- eassert (equal_kind != EQUAL_NO_QUIT);
- return compare_window_configurations (o1, o2, false);
+ return (size == bool_vector_size (o2)
+ && !memcmp (bool_vector_data (o1), bool_vector_data (o2),
+ bool_vector_bytes (size)));
}
/* Aside from them, only true vectors, char-tables, compiled
@@ -2493,16 +2474,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
break;
case Lisp_String:
- if (SCHARS (o1) != SCHARS (o2))
- return false;
- if (SBYTES (o1) != SBYTES (o2))
- return false;
- if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)))
- return false;
- if (equal_kind == EQUAL_INCLUDING_PROPERTIES
- && !compare_string_intervals (o1, o2))
- return false;
- return true;
+ return (SCHARS (o1) == SCHARS (o2)
+ && SBYTES (o1) == SBYTES (o2)
+ && !memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))
+ && (equal_kind != EQUAL_INCLUDING_PROPERTIES
+ || compare_string_intervals (o1, o2)));
default:
break;
@@ -2532,26 +2508,36 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
}
else if (STRINGP (array))
{
- register unsigned char *p = SDATA (array);
- int charval;
+ unsigned char *p = SDATA (array);
CHECK_CHARACTER (item);
- charval = XFIXNAT (item);
+ int charval = XFIXNAT (item);
size = SCHARS (array);
- if (STRING_MULTIBYTE (array))
+ if (size != 0)
{
+ CHECK_IMPURE (array, XSTRING (array));
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (charval, str);
- ptrdiff_t size_byte = SBYTES (array);
- ptrdiff_t product;
+ int len;
+ if (STRING_MULTIBYTE (array))
+ len = CHAR_STRING (charval, str);
+ else
+ {
+ str[0] = charval;
+ len = 1;
+ }
- if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
- error ("Attempt to change byte length of a string");
- for (idx = 0; idx < size_byte; idx++)
- *p++ = str[idx % len];
+ ptrdiff_t size_byte = SBYTES (array);
+ if (len == 1 && size == size_byte)
+ memset (p, str[0], size);
+ else
+ {
+ ptrdiff_t product;
+ if (INT_MULTIPLY_WRAPV (size, len, &product)
+ || product != size_byte)
+ error ("Attempt to change byte length of a string");
+ for (idx = 0; idx < size_byte; idx++)
+ *p++ = str[idx % len];
+ }
}
- else
- for (idx = 0; idx < size; idx++)
- p[idx] = charval;
}
else if (BOOL_VECTOR_P (array))
return bool_vector_fill (array, item);
@@ -2566,12 +2552,15 @@ DEFUN ("clear-string", Fclear_string, Sclear_string,
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- ptrdiff_t len;
CHECK_STRING (string);
- len = SBYTES (string);
- memset (SDATA (string), 0, len);
- STRING_SET_CHARS (string, len);
- STRING_SET_UNIBYTE (string);
+ ptrdiff_t len = SBYTES (string);
+ if (len != 0 || STRING_MULTIBYTE (string))
+ {
+ CHECK_IMPURE (string, XSTRING (string));
+ memset (SDATA (string), 0, len);
+ STRING_SET_CHARS (string, len);
+ STRING_SET_UNIBYTE (string);
+ }
return Qnil;
}
@@ -2624,51 +2613,45 @@ usage: (nconc &rest LISTS) */)
static EMACS_INT
mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
- Lisp_Object tail, dummy;
- EMACS_INT i;
-
if (VECTORP (seq) || COMPILEDP (seq))
{
- for (i = 0; i < leni; i++)
+ for (ptrdiff_t i = 0; i < leni; i++)
{
- dummy = call1 (fn, AREF (seq, i));
+ Lisp_Object dummy = call1 (fn, AREF (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (BOOL_VECTOR_P (seq))
{
- for (i = 0; i < leni; i++)
+ for (EMACS_INT i = 0; i < leni; i++)
{
- dummy = call1 (fn, bool_vector_ref (seq, i));
+ Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (STRINGP (seq))
{
- ptrdiff_t i_byte;
+ ptrdiff_t i_byte = 0;
- for (i = 0, i_byte = 0; i < leni;)
+ for (ptrdiff_t i = 0; i < leni;)
{
- int c;
ptrdiff_t i_before = i;
-
- FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
- XSETFASTINT (dummy, c);
- dummy = call1 (fn, dummy);
+ int c = fetch_string_char_advance (seq, &i, &i_byte);
+ Lisp_Object dummy = call1 (fn, make_fixnum (c));
if (vals)
vals[i_before] = dummy;
}
}
else /* Must be a list, since Flength did not get an error */
{
- tail = seq;
- for (i = 0; i < leni; i++)
+ Lisp_Object tail = seq;
+ for (ptrdiff_t i = 0; i < leni; i++)
{
if (! CONSP (tail))
return i;
- dummy = call1 (fn, XCAR (tail));
+ Lisp_Object dummy = call1 (fn, XCAR (tail));
if (vals)
vals[i] = dummy;
tail = XCDR (tail);
@@ -2853,7 +2836,7 @@ advisable. */)
while (loads-- > 0)
{
Lisp_Object load = (NILP (use_floats)
- ? make_fixnum (100.0 * load_ave[loads])
+ ? double_to_integer (100.0 * load_ave[loads])
: make_float (load_ave[loads]));
ret = Fcons (load, ret);
}
@@ -3461,7 +3444,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3504,7 +3487,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3529,7 +3512,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3710,7 +3693,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value >> 16 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3752,7 +3735,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value >> 8 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3782,7 +3765,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
c = value & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -4022,7 +4005,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
Lisp_Object
hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- return make_ufixnum (sxhash (key, 0));
+ return make_ufixnum (sxhash (key));
}
/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys.
@@ -4042,7 +4025,7 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
{
Lisp_Object args[] = { h->test.user_hash_function, key };
Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
- return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0));
+ return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash));
}
struct hash_table_test const
@@ -4422,7 +4405,7 @@ hash_clear (struct Lisp_Hash_Table *h)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
if (!hash_rehash_needed_p (h))
- memclear (XVECTOR (h->hash)->contents, size * word_size);
+ memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
@@ -4606,13 +4589,13 @@ sxhash_list (Lisp_Object list, int depth)
CONSP (list) && i < SXHASH_MAX_LEN;
list = XCDR (list), ++i)
{
- EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (XCAR (list), depth + 1);
hash = sxhash_combine (hash, hash2);
}
if (!NILP (list))
{
- EMACS_UINT hash2 = sxhash (list, depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (list, depth + 1);
hash = sxhash_combine (hash, hash2);
}
@@ -4632,7 +4615,7 @@ sxhash_vector (Lisp_Object vec, int depth)
n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash);
for (i = 0; i < n; ++i)
{
- EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
+ EMACS_UINT hash2 = sxhash_obj (AREF (vec, i), depth + 1);
hash = sxhash_combine (hash, hash2);
}
@@ -4675,58 +4658,78 @@ sxhash_bignum (Lisp_Object bignum)
structure. Value is an unsigned integer clipped to INTMASK. */
EMACS_UINT
-sxhash (Lisp_Object obj, int depth)
+sxhash (Lisp_Object obj)
{
- EMACS_UINT hash;
+ return sxhash_obj (obj, 0);
+}
+static EMACS_UINT
+sxhash_obj (Lisp_Object obj, int depth)
+{
if (depth > SXHASH_MAX_DEPTH)
return 0;
switch (XTYPE (obj))
{
case_Lisp_Int:
- hash = XUFIXNUM (obj);
- break;
+ return XUFIXNUM (obj);
case Lisp_Symbol:
- hash = XHASH (obj);
- break;
+ return XHASH (obj);
case Lisp_String:
- hash = sxhash_string (SSDATA (obj), SBYTES (obj));
- break;
+ return sxhash_string (SSDATA (obj), SBYTES (obj));
- /* This can be everything from a vector to an overlay. */
case Lisp_Vectorlike:
- if (BIGNUMP (obj))
- hash = sxhash_bignum (obj);
- else if (VECTORP (obj) || RECORDP (obj))
- /* According to the CL HyperSpec, two arrays are equal only if
- they are `eq', except for strings and bit-vectors. In
- Emacs, this works differently. We have to compare element
- by element. Same for records. */
- hash = sxhash_vector (obj, depth);
- else if (BOOL_VECTOR_P (obj))
- hash = sxhash_bool_vector (obj);
- else
- /* Others are `equal' if they are `eq', so let's take their
- address as hash. */
- hash = XHASH (obj);
- break;
+ {
+ enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
+ if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
+ {
+ /* According to the CL HyperSpec, two arrays are equal only if
+ they are 'eq', except for strings and bit-vectors. In
+ Emacs, this works differently. We have to compare element
+ by element. Same for pseudovectors that internal_equal
+ examines the Lisp contents of. */
+ return (SUB_CHAR_TABLE_P (obj)
+ /* 'sxhash_vector' can't be applies to a sub-char-table and
+ it's probably not worth looking into them anyway! */
+ ? 42
+ : sxhash_vector (obj, depth));
+ }
+ else if (pvec_type == PVEC_BIGNUM)
+ return sxhash_bignum (obj);
+ else if (pvec_type == PVEC_MARKER)
+ {
+ ptrdiff_t bytepos
+ = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
+ EMACS_UINT hash
+ = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
+ return SXHASH_REDUCE (hash);
+ }
+ else if (pvec_type == PVEC_BOOL_VECTOR)
+ return sxhash_bool_vector (obj);
+ else if (pvec_type == PVEC_OVERLAY)
+ {
+ EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
+ hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
+ hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth));
+ return SXHASH_REDUCE (hash);
+ }
+ else
+ /* Others are 'equal' if they are 'eq', so take their
+ address as hash. */
+ return XHASH (obj);
+ }
case Lisp_Cons:
- hash = sxhash_list (obj, depth);
- break;
+ return sxhash_list (obj, depth);
case Lisp_Float:
- hash = sxhash_float (XFLOAT_DATA (obj));
- break;
+ return sxhash_float (XFLOAT_DATA (obj));
default:
emacs_abort ();
}
-
- return hash;
}
@@ -5177,22 +5180,8 @@ extract_data_from_object (Lisp_Object spec,
struct buffer *bp = XBUFFER (object);
set_buffer_internal (bp);
- if (NILP (start))
- b = BEGV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start);
- b = XFIXNUM (start);
- }
-
- if (NILP (end))
- e = ZV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end);
- e = XFIXNUM (end);
- }
-
+ b = !NILP (start) ? fix_position (start) : BEGV;
+ e = !NILP (end) ? fix_position (end) : ZV;
if (b > e)
{
EMACS_INT temp = b;
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-10 11:44:09 +0000