/* 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,
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;
/* "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 ();
+static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special));
#endif
/* ARGSUSED */
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);
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;
}
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = XCDR (tail))
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
if (!FLOATP (elt))
return Fmemq (elt, list);
- for (tail = list; !NILP (tail); tail = XCDR (tail))
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
{
Lisp_Object tail, prev;
- for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
+ for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
{
CHECK_LIST_CONS (tail, seq);
prev = tail;
QUIT;
}
- newcell = Fcons (prop, Fcons (val, Qnil));
+ newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
return newcell;
else
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;
}
{
CHECK_CHAR_TABLE (parent);
- for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
+ for (temp = parent; CHAR_TABLE_P (temp);
+ temp = XCHAR_TABLE (temp)->parent)
if (EQ (temp, char_table))
error ("Attempt to make a chartable be its own parent");
}
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