/* Random utility Lisp functions.
- Copyright (C) 1985-1987, 1993-1995, 1997-2011
+ Copyright (C) 1985-1987, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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;
if (EQ (limit, Qt))
{
- EMACS_TIME t;
- EMACS_GET_TIME (t);
- seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_USECS (t));
+ EMACS_TIME t = current_emacs_time ();
+ seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_NSECS (t));
}
if (NATNUMP (limit) && XFASTINT (limit) != 0)
if (STRING_MULTIBYTE (string))
{
ptrdiff_t bytes = SBYTES (string);
- unsigned char *str = (unsigned char *) xmalloc (bytes);
+ unsigned char *str = xmalloc (bytes);
memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
if (STRING_MULTIBYTE (string))
{
ptrdiff_t chars = SCHARS (string);
- unsigned char *str = (unsigned char *) xmalloc (chars);
+ unsigned char *str = xmalloc (chars);
ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars, 0);
if (converted < chars)
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 =
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;
}
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to - from, &AREF (string, from));
+ res = Fvector (to - from, aref_addr (string, from));
return res;
}
(Lisp_Object symbol, Lisp_Object propname)
{
CHECK_SYMBOL (symbol);
- return Fplist_get (XSYMBOL (symbol)->plist, propname);
+ return Fplist_get (SVAR (XSYMBOL (symbol), plist), propname);
}
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist
- = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
+ SVAR (XSYMBOL (symbol), plist)
+ = Fplist_put (SVAR (XSYMBOL (symbol), plist), propname, value);
return value;
}
\f
|| !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
depth + 1, props))
return 0;
- o1 = XOVERLAY (o1)->plist;
- o2 = XOVERLAY (o2)->plist;
+ o1 = MVAR (XOVERLAY (o1), plist);
+ o2 = MVAR (XOVERLAY (o2), plist);
goto tail_recurse;
}
if (MARKERP (o1))
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_COMPILED | PVEC_CHAR_TABLE
+ | PVEC_SUB_CHAR_TABLE | PVEC_FONT)
+ << PSEUDOVECTOR_SIZE_BITS)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
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),
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
Faset (v, make_number (i),
code_convert_string_norecord (val, Vlocale_coding_system, 0));
}
return decoded_string;
}
-/* Base64-decode the data at FROM of LENGHT bytes into TO. If
+/* Base64-decode the data at FROM of LENGTH 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
+ form. If NCHARS_RETURN is not NULL, store the number of produced
characters in *NCHARS_RETURN. */
static ptrdiff_t
vector that are not copied from VEC are set to nil. */
Lisp_Object
-larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t size_max)
+larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
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 <= size_max && size_max < C_language_max
- ? size_max : C_language_max);
- xassert (VECTORP (vec));
- xassert (0 < incr_min && -1 <= size_max);
+ 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);
incr_max = n_max - old_size;
incr = max (incr_min, min (old_size >> 1, incr_max));
hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
hash = sxhash (key, 0);
else
hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash = sxhash (key, 0);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
double index_float;
/* Preconditions. */
- xassert (SYMBOLP (test));
- xassert (INTEGERP (size) && XINT (size) >= 0);
- xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
+ eassert (SYMBOLP (test));
+ 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);
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next (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))
if (INDEX_SIZE_BOUND < nsize)
error ("Hash table too large to resize");
+#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
+
h->key_and_value = larger_vector (h->key_and_value,
2 * (new_size - old_size), -1);
h->next = larger_vector (h->next, new_size - old_size, -1);
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 (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 (h, XFASTINT (last), make_number (old_size));
}
else
XSETFASTINT (h->next_free, old_size);
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
ptrdiff_t 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);
+ set_hash_next (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index (h, start_of_bucket, make_number (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 (h, i, key);
+ set_hash_value (h, i, value);
/* Remember its hash code. */
- HASH_HASH (h, i) = make_number (hash);
+ set_hash_hash (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 (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index (h, start_of_bucket, make_number (i));
return i;
}
{
/* Take entry out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
+ set_hash_index (h, start_of_bucket, HASH_NEXT (h, i));
else
- HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
+ set_hash_next (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 (h, i, Qnil);
+ set_hash_value (h, i, Qnil);
+ set_hash_hash (h, i, Qnil);
+ set_hash_next (h, i, h->next_free);
h->next_free = make_number (i);
h->count--;
- xassert (h->count >= 0);
+ eassert (h->count >= 0);
break;
}
else
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 (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
+ set_hash_key (h, i, Qnil);
+ set_hash_value (h, i, Qnil);
+ set_hash_hash (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
entries from the table that don't survive the current GC.
REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
{
/* Take out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, bucket) = next;
+ set_hash_index (h, bucket, next);
else
- HASH_NEXT (h, XFASTINT (prev)) = next;
+ set_hash_next (h, XFASTINT (prev), next);
/* Add to free list. */
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_next (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 (h, i, Qnil);
+ set_hash_value (h, i, Qnil);
+ set_hash_hash (h, i, Qnil);
h->count--;
}
/* 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 = hash_lookup (h, key, &hash);
if (i >= 0)
- HASH_VALUE (h, i) = value;
+ set_hash_value (h, i, value);
else
hash_put (h, key, value, hash);
}
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);
#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 (&Ssecure_hash);
defsubr (&Slocale_info);
}
-
-
-void
-init_fns (void)
-{
-}