/* Random utility Lisp functions.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006 Free Software Foundation, Inc.
+ 2005, 2006, 2007 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
All integers representable in Lisp are equally likely.
On most systems, this is 29 bits' worth.
With positive integer argument N, return random number in interval [0,N).
-With argument t, set the random number seed from the current time and pid. */)
+With argument t, set the random number seed from the current time and pid. */)
(n)
Lisp_Object n;
{
A byte-code function object is also allowed.
If the string contains multibyte characters, this is not necessarily
the number of bytes in the string; it is the number of characters.
-To get the number of bytes, use `string-bytes'. */)
+To get the number of bytes, use `string-bytes'. */)
(sequence)
register Lisp_Object sequence;
{
if (STRINGP (sequence))
XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
- XSETFASTINT (val, XVECTOR (sequence)->size);
+ XSETFASTINT (val, ASIZE (sequence));
else if (SUB_CHAR_TABLE_P (sequence))
XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS);
else if (CHAR_TABLE_P (sequence))
else if (BOOL_VECTOR_P (sequence))
XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
else if (COMPILEDP (sequence))
- XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
+ XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
i = 0;
else if (NILP (sequence))
XSETFASTINT (val, 0);
else
- val = wrong_type_argument (Qsequencep, sequence);
+ wrong_type_argument (Qsequencep, sequence);
return val;
}
doc: /* Return the length of a list, but avoid error or infinite loop.
This function never gets an error. If LIST is not really a list,
it returns 0. If LIST is circular, it returns a finite value
-which is at least the number of distinct elements. */)
+which is at least the number of distinct elements. */)
(list)
Lisp_Object list;
{
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
doc: /* Return the number of bytes in STRING.
-If STRING is a multibyte string, this is greater than the length of STRING. */)
+If STRING is a multibyte string, this is greater than the length of STRING. */)
(string)
Lisp_Object string;
{
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
doc: /* Return t if two strings have identical contents.
Case is significant, but text properties are ignored.
-Symbols are also allowed; their print names are used instead. */)
+Symbols are also allowed; their print names are used instead. */)
(s1, s2)
register Lisp_Object s1, s2;
{
If string STR1 is less, the value is a negative number N;
- 1 - N is the number of characters that match at the beginning.
If string STR1 is greater, the value is a positive number N;
- N - 1 is the number of characters that match at the beginning. */)
+ N - 1 is the number of characters that match at the beginning. */)
(str1, start1, end1, str2, start2, end2, ignore_case)
Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
{
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
doc: /* Return t if first arg string is less than second in lexicographic order.
Case is significant.
-Symbols are also allowed; their print names are used instead. */)
+Symbols are also allowed; their print names are used instead. */)
(s1, s2)
register Lisp_Object s1, s2;
{
return i1 < SCHARS (s2) ? Qt : Qnil;
}
\f
-static Lisp_Object concat ();
+#if __GNUC__
+/* "gcc -O3" enables automatic function inlining, which optimizes out
+ the arguments for the invocations of this function, whereas it
+ expects these values on the stack. */
+static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)) __attribute__((noinline));
+#else /* !__GNUC__ */
+static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special));
+#endif
/* ARGSUSED */
Lisp_Object
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
doc: /* Return a copy of a list, vector, string or char-table.
The elements of a list or vector are not copied; they are shared
-with the original. */)
+with the original. */)
(arg)
Lisp_Object arg;
{
if (VECTORP (this))
for (i = 0; i < len; i++)
{
- ch = XVECTOR (this)->contents[i];
+ ch = AREF (this, i);
CHECK_NUMBER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
thisindex++;
}
else
- elt = XVECTOR (this)->contents[thisindex++];
+ elt = AREF (this, thisindex++);
/* Store this element into the result. */
if (toindex < 0)
tail = XCDR (tail);
}
else if (VECTORP (val))
- XVECTOR (val)->contents[toindex++] = elt;
+ AREF (val, toindex++) = elt;
else
{
CHECK_NUMBER (elt);
Multibyte character codes are converted to unibyte according to
`nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'.
If the lookup in the translation table fails, this function takes just
-the low 8 bits of each character. */)
+the low 8 bits of each character. */)
(string)
Lisp_Object string;
{
size_byte = SBYTES (string);
}
else
- size = XVECTOR (string)->size;
+ size = ASIZE (string);
if (NILP (to))
{
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to_char - from_char,
- XVECTOR (string)->contents + from_char);
+ res = Fvector (to_char - from_char, &AREF (string, from_char));
return res;
}
size_byte = SBYTES (string);
}
else
- size = XVECTOR (string)->size;
+ size = ASIZE (string);
if (!(0 <= from && from <= to && to <= size))
args_out_of_range_3 (string, make_number (from), make_number (to));
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to - from,
- XVECTOR (string)->contents + from);
+ res = Fvector (to - from, &AREF (string, from));
return res;
}
}
DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
- doc: /* Return non-nil if ELT is an element of LIST.
-Comparison done with `eq'. The value is actually the tail of LIST
-whose car is ELT. */)
+doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
+The value is actually the tail of LIST whose car is ELT. */)
(elt, list)
- Lisp_Object elt, list;
+ register Lisp_Object elt, list;
{
while (1)
{
return list;
}
+DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
+doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'.
+The value is actually the tail of LIST whose car is ELT. */)
+ (elt, list)
+ register Lisp_Object elt;
+ Lisp_Object list;
+{
+ register Lisp_Object tail;
+
+ if (!FLOATP (elt))
+ return Fmemq (elt, list);
+
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
+ {
+ register Lisp_Object tem;
+ CHECK_LIST_CONS (tail, list);
+ tem = XCAR (tail);
+ if (FLOATP (tem) && internal_equal (elt, tem, 0, 0))
+ return tail;
+ QUIT;
+ }
+ return Qnil;
+}
+
DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST.
The value is actually the first element of LIST whose car is KEY.
case Lisp_Vectorlike:
{
register int i;
- EMACS_INT size = XVECTOR (o1)->size;
+ EMACS_INT 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. */
- if (XVECTOR (o2)->size != size)
+ if (ASIZE (o2) != size)
return 0;
/* Boolvectors are compared much like strings. */
if (BOOL_VECTOR_P (o1))
for (i = 0; i < size; i++)
{
Lisp_Object v1, v2;
- v1 = XVECTOR (o1)->contents [i];
- v2 = XVECTOR (o2)->contents [i];
+ v1 = AREF (o1, i);
+ v2 = AREF (o2, i);
if (!internal_equal (v1, v2, depth + 1, props))
return 0;
}
if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
- size = XVECTOR (array)->size;
+ size = ASIZE (array);
for (index = 0; index < size; index++)
p[index] = item;
}
charset_info = Fget (range, Qcharset);
CHECK_VECTOR (charset_info);
- charset_id = XINT (XVECTOR (charset_info)->contents[0]);
+ charset_id = XINT (AREF (charset_info, 0));
ch = Fmake_char_internal (make_number (charset_id),
make_number (0), make_number (0));
}
Faset (char_table, range, value);
else if (VECTORP (range))
{
- int size = XVECTOR (range)->size;
+ int size = ASIZE (range);
Lisp_Object *val = XVECTOR (range)->contents;
Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
size <= 1 ? Qnil : val[1],
else
from = 32, to = 128;
- if (!SUB_CHAR_TABLE_P (*table))
+ if (!SUB_CHAR_TABLE_P (*table)
+ || ! NILP (XCHAR_TABLE (*table)->defalt))
return;
elt = XCHAR_TABLE (*table)->contents[from++];
for (; from < to; from++)
Lisp_Object table;
{
Lisp_Object elt;
- int dim;
+ int dim, chars;
int i, j;
CHECK_CHAR_TABLE (table);
if (!SUB_CHAR_TABLE_P (elt))
continue;
dim = CHARSET_DIMENSION (i - 128);
+ chars = CHARSET_CHARS (i - 128);
if (dim == 2)
for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
- optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);
- optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim);
+ optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, chars);
+ optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, chars);
}
return Qnil;
}
void
map_char_table (c_function, function, table, subtable, arg, depth, indices)
void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- Lisp_Object function, table, subtable, arg, *indices;
- int depth;
+ Lisp_Object function, table, subtable, arg;
+ int depth, *indices;
{
int i, to;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
}
else
{
- int charset = XFASTINT (indices[0]) - 128;
+ int charset = indices[0] - 128;
i = 32;
to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
int charset;
elt = XCHAR_TABLE (subtable)->contents[i];
- XSETFASTINT (indices[depth], i);
- charset = XFASTINT (indices[0]) - 128;
+ indices[depth] = i;
+ charset = indices[0] - 128;
if (depth == 0
&& (!CHARSET_DEFINED_P (charset)
|| charset == CHARSET_8_BIT_CONTROL
{
int c1, c2, c;
- c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
- c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
+ c1 = depth >= 1 ? indices[1] : 0;
+ c2 = depth >= 2 ? indices[2] : 0;
c = MAKE_CHAR (charset, c1, c2);
if (NILP (elt))
Lisp_Object function, char_table;
{
/* The depth of char table is at most 3. */
- Lisp_Object indices[3];
+ int indices[3];
CHECK_CHAR_TABLE (char_table);
/* When Lisp_Object is represented as a union, `call2' cannot directly
be passed to map_char_table because it returns a Lisp_Object rather
than returning nothing.
- Casting leads to crashes on some architectures. -stef */
+ Casting leads to crashes on some architectures. --Stef */
map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices);
return Qnil;
}
else
GCPRO2 (fn, seq);
/* We need not explicitly protect `tail' because it is used only on lists, and
- 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
+ 1) lists are not relocated and 2) the list is marked via `seq' so will not
+ be freed */
if (VECTORP (seq))
{
for (i = 0; i < leni; i++)
{
- dummy = XVECTOR (seq)->contents[i];
- dummy = call1 (fn, dummy);
+ dummy = call1 (fn, AREF (seq, i));
if (vals)
vals[i] = dummy;
}
{
int byte;
byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
- if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)))
- dummy = Qt;
- else
- dummy = Qnil;
-
+ dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
dummy = call1 (fn, dummy);
if (vals)
vals[i] = dummy;
len = Flength (sequence);
leni = XINT (len);
nargs = leni + leni - 1;
- if (nargs < 0) return build_string ("");
+ if (nargs < 0) return empty_unibyte_string;
SAFE_ALLOCA_LISP (args, nargs);
Fraise_frame (mini_frame);
}
- obj = read_filtered_event (1, 0, 0, 0);
+ obj = read_filtered_event (1, 0, 0, 0, Qnil);
cursor_in_echo_area = 0;
/* If we need to quit, quit with cursor_in_echo_area = 0. */
QUIT;
doc: /* Returns t if FEATURE is present in this Emacs.
Use this to conditionalize execution of lisp code based on the
-presence or absence of emacs or environment extensions.
+presence or absence of Emacs or environment extensions.
Use `provide' to declare that a feature is available. This function
looks at the value of the variable `features'. The optional argument
SUBFEATURE can be used to check a specific subfeature of FEATURE. */)
/* The list of all weak hash tables. Don't staticpro this one. */
-Lisp_Object Vweak_hash_tables;
+struct Lisp_Hash_Table *weak_hash_tables;
/* Various symbols. */
int i, old_size;
xassert (VECTORP (vec));
- old_size = XVECTOR (vec)->size;
+ old_size = ASIZE (vec);
xassert (new_size >= old_size);
v = allocate_vector (new_size);
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash code returned from \
-user-supplied hash function"),
- hash));
+ signal_error ("Invalid hash code returned from user-supplied hash function", hash);
return XUINT (hash);
}
/* Maybe add this hash table to the list of all weak hash tables. */
if (NILP (h->weak))
- h->next_weak = Qnil;
+ h->next_weak = NULL;
else
{
- h->next_weak = Vweak_hash_tables;
- Vweak_hash_tables = table;
+ h->next_weak = weak_hash_tables;
+ weak_hash_tables = h;
}
return table;
/* Maybe add this hash table to the list of all weak hash tables. */
if (!NILP (h2->weak))
{
- h2->next_weak = Vweak_hash_tables;
- Vweak_hash_tables = table;
+ h2->next_weak = weak_hash_tables;
+ weak_hash_tables = h2;
}
return table;
{
int old_size = HASH_TABLE_SIZE (h);
int i, new_size, index_size;
+ EMACS_INT nsize;
if (INTEGERP (h->rehash_size))
new_size = old_size + XFASTINT (h->rehash_size);
index_size = next_almost_prime ((int)
(new_size
/ XFLOATINT (h->rehash_threshold)));
- if (max (index_size, 2 * new_size) > MOST_POSITIVE_FIXNUM)
+ /* Assignment to EMACS_INT stops GCC whining about limited range
+ of data type. */
+ nsize = max (index_size, 2 * new_size);
+ if (nsize > MOST_POSITIVE_FIXNUM)
error ("Hash table too large to resize");
h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
if (!NILP (HASH_HASH (h, i)))
{
unsigned hash_code = XUINT (HASH_HASH (h, i));
- int start_of_bucket = hash_code % XVECTOR (h->index)->size;
+ 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);
}
if (hash)
*hash = hash_code;
- start_of_bucket = hash_code % XVECTOR (h->index)->size;
+ start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
/* We need not gcpro idx since it's either an integer or nil. */
HASH_HASH (h, i) = make_number (hash);
/* Add new entry to its collision chain. */
- start_of_bucket = hash % XVECTOR (h->index)->size;
+ 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);
return i;
Lisp_Object idx, prev;
hash_code = h->hashfn (h, key);
- start_of_bucket = hash_code % XVECTOR (h->index)->size;
+ start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
HASH_HASH (h, i) = Qnil;
}
- for (i = 0; i < XVECTOR (h->index)->size; ++i)
- XVECTOR (h->index)->contents[i] = Qnil;
+ for (i = 0; i < ASIZE (h->index); ++i)
+ AREF (h->index, i) = Qnil;
h->next_free = make_number (0);
h->count = make_number (0);
{
int bucket, n, marked;
- n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG;
+ n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
marked = 0;
for (bucket = 0; bucket < n; ++bucket)
/* Remove elements from weak hash tables that don't survive the
current garbage collection. Remove weak tables that don't survive
- from Vweak_hash_tables. Called from gc_sweep. */
+ from weak_hash_tables. Called from gc_sweep. */
void
sweep_weak_hash_tables ()
{
- Lisp_Object table, used, next;
- struct Lisp_Hash_Table *h;
+ struct Lisp_Hash_Table *h, *used, *next;
int marked;
/* Mark all keys and values that are in use. Keep on marking until
do
{
marked = 0;
- for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak)
+ for (h = weak_hash_tables; h; h = h->next_weak)
{
- h = XHASH_TABLE (table);
if (h->size & ARRAY_MARK_FLAG)
marked |= sweep_weak_table (h, 0);
}
while (marked);
/* Remove tables and entries that aren't used. */
- for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next)
+ for (h = weak_hash_tables, used = NULL; h; h = next)
{
- h = XHASH_TABLE (table);
next = h->next_weak;
if (h->size & ARRAY_MARK_FLAG)
/* Add table to the list of used weak hash tables. */
h->next_weak = used;
- used = table;
+ used = h;
}
}
- Vweak_hash_tables = used;
+ weak_hash_tables = used;
}
c = *p++;
if (c >= 0140)
c -= 40;
- hash = ((hash << 3) + (hash >> 28) + c);
+ hash = ((hash << 4) + (hash >> 28) + c);
}
return hash & INTMASK;
Lisp_Object vec;
int depth;
{
- unsigned hash = XVECTOR (vec)->size;
+ unsigned hash = ASIZE (vec);
int i, n;
- n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size);
+ n = min (SXHASH_MAX_LEN, ASIZE (vec));
for (i = 0; i < n; ++i)
{
- unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1);
+ unsigned hash2 = sxhash (AREF (vec, i), depth + 1);
hash = SXHASH_COMBINE (hash, hash2);
}
(obj)
Lisp_Object obj;
{
- unsigned hash = sxhash (obj, 0);;
+ unsigned hash = sxhash (obj, 0);
return make_number (hash);
}
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
- test));
+ signal_error ("Invalid hash table test", test);
user_test = XCAR (prop);
user_hash = XCAR (XCDR (prop));
}
if (NILP (size))
size = make_number (DEFAULT_HASH_SIZE);
else if (!INTEGERP (size) || XINT (size) < 0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table size"),
- size));
+ signal_error ("Invalid hash table size", size);
/* Look for `:rehash-size SIZE'. */
i = get_key_arg (QCrehash_size, nargs, args, used);
if (!NUMBERP (rehash_size)
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
|| XFLOATINT (rehash_size) <= 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash size"),
- rehash_size));
+ signal_error ("Invalid hash table rehash size", rehash_size);
/* Look for `:rehash-threshold THRESHOLD'. */
i = get_key_arg (QCrehash_threshold, nargs, args, used);
if (!FLOATP (rehash_threshold)
|| XFLOATINT (rehash_threshold) <= 0.0
|| XFLOATINT (rehash_threshold) > 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash threshold"),
- rehash_threshold));
+ signal_error ("Invalid hash table rehash threshold", rehash_threshold);
/* Look for `:weakness WEAK'. */
i = get_key_arg (QCweakness, nargs, args, used);
&& !EQ (weak, Qvalue)
&& !EQ (weak, Qkey_or_value)
&& !EQ (weak, Qkey_and_value))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
- weak));
+ signal_error ("Invalid hash table weakness", weak);
/* Now, all args should have been used up, or there's a problem. */
for (i = 0; i < nargs; ++i)
if (!used[i])
- Fsignal (Qerror,
- list2 (build_string ("Invalid argument list"), args[i]));
+ signal_error ("Invalid argument list", args[i]);
return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
user_test, user_hash);
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
if (STRING_MULTIBYTE (object))
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
}
Fset (Qyes_or_no_p_history, Qnil);
DEFVAR_LISP ("features", &Vfeatures,
- doc: /* A list of symbols which are the features of the executing emacs.
+ doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = Fcons (intern ("emacs"), Qnil);
Qsubfeatures = intern ("subfeatures");
defsubr (&Selt);
defsubr (&Smember);
defsubr (&Smemq);
+ defsubr (&Smemql);
defsubr (&Sassq);
defsubr (&Sassoc);
defsubr (&Srassq);
void
init_fns ()
{
- Vweak_hash_tables = Qnil;
+ weak_hash_tables = NULL;
}
/* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31
HCoop / bpt / emacs.git / blobdiff