/* 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;
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;
{
/* "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 () __attribute__((noinline));
+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 */
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;
}
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],
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);
{
#ifdef HAVE_MENUS
- if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ if (FRAME_WINDOW_P (SELECTED_FRAME ())
+ && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{
Fraise_frame (mini_frame);
}
+ temporarily_switch_to_single_kboard (SELECTED_FRAME ());
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. */
CHECK_STRING (prompt);
#ifdef HAVE_MENUS
- if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ if (FRAME_WINDOW_P (SELECTED_FRAME ())
+ && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{
/* 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);
h->weak = weak;
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
- h->count = make_number (0);
+ h->count = 0;
h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil);
h->hash = Fmake_vector (size, Qnil);
h->next = Fmake_vector (size, Qnil);
/* 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. */
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
- h->count = make_number (XFASTINT (h->count) + 1);
+ h->count++;
/* Store key/value in the key_and_value vector. */
i = XFASTINT (h->next_free);
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_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil;
HASH_NEXT (h, i) = h->next_free;
h->next_free = make_number (i);
- h->count = make_number (XFASTINT (h->count) - 1);
- xassert (XINT (h->count) >= 0);
+ h->count--;
+ xassert (h->count >= 0);
break;
}
else
hash_clear (h)
struct Lisp_Hash_Table *h;
{
- if (XFASTINT (h->count) > 0)
+ if (h->count > 0)
{
int i, size = HASH_TABLE_SIZE (h);
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);
+ h->count = 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)
HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
HASH_HASH (h, i) = Qnil;
- h->count = make_number (XFASTINT (h->count) - 1);
+ h->count--;
}
else
{
/* 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)
{
/* TABLE is marked as used. Sweep its contents. */
- if (XFASTINT (h->count) > 0)
+ if (h->count > 0)
sweep_weak_table (h, 1);
/* 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;
}
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);
}
(table)
Lisp_Object table;
{
- return check_hash_table (table)->count;
+ return make_number (check_hash_table (table)->count);
}
void
init_fns ()
{
- Vweak_hash_tables = Qnil;
+ weak_hash_tables = NULL;
}
/* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31
HCoop / bpt / emacs.git / blobdiff