static int internal_old_equal (Lisp_Object, Lisp_Object, int);
static Lisp_Object
-mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_bit_vector (Lisp_Object obj)
{
return Qnil;
}
static void
print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
- int i;
+ size_t i;
struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
- int len = bit_vector_length (v);
- int last = len;
+ size_t len = bit_vector_length (v);
+ size_t last = len;
if (INTP (Vprint_length))
last = min (len, XINT (Vprint_length));
sizeof (long)));
}
+static const struct lrecord_description bit_vector_description[] = {
+ { XD_LISP_OBJECT, offsetof(Lisp_Bit_Vector, next), 1 },
+ { XD_END }
+};
+
+
DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector,
mark_bit_vector, print_bit_vector, 0,
- bit_vector_equal, bit_vector_hash, 0,
+ bit_vector_equal, bit_vector_hash,
+ bit_vector_description,
struct Lisp_Bit_Vector);
\f
DEFUN ("identity", Fidentity, 1, 1, 0, /*
return make_int (XSTRING_CHAR_LENGTH (sequence));
else if (CONSP (sequence))
{
- int len;
+ size_t len;
GET_EXTERNAL_LIST_LENGTH (sequence, len);
return make_int (len);
}
(list))
{
Lisp_Object hare, tortoise;
- int len;
+ size_t len;
for (hare = tortoise = list, len = 0;
CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list));
Lisp_Object last = list_copy;
Lisp_Object hare, tortoise;
- int len;
+ size_t len;
for (tortoise = hare = XCDR (list), len = 1;
CONSP (hare);
*/
(seq, from, to))
{
- int len, f, t;
+ EMACS_INT len, f, t;
if (STRINGP (seq))
return Fsubstring (seq, from, to);
if (VECTORP (seq))
{
Lisp_Object result = make_vector (t - f, Qnil);
- int i;
+ EMACS_INT i;
Lisp_Object *in_elts = XVECTOR_DATA (seq);
Lisp_Object *out_elts = XVECTOR_DATA (result);
if (LISTP (seq))
{
Lisp_Object result = Qnil;
- int i;
+ EMACS_INT i;
seq = Fnthcdr (make_int (f), seq);
/* bit vector */
{
Lisp_Object result = make_bit_vector (t - f, Qzero);
- int i;
+ EMACS_INT i;
for (i = f; i < t; i++)
set_bit_vector_bit (XBIT_VECTOR (result), i - f,
*/
(n, list))
{
- REGISTER int i;
+ REGISTER size_t i;
REGISTER Lisp_Object tail = list;
CHECK_NATNUM (n);
for (i = XINT (n); i; i--)
#ifdef LOSING_BYTECODE
else if (COMPILED_FUNCTIONP (sequence))
{
- int idx = XINT (n);
+ EMACS_INT idx = XINT (n);
if (idx < 0)
{
lose:
*/
(list, n))
{
- int int_n, count;
+ EMACS_INT int_n, count;
Lisp_Object retval, tortoise, hare;
CHECK_LIST (list);
*/
(list, n))
{
- int int_n;
+ EMACS_INT int_n;
CHECK_LIST (list);
plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present,
int laxp, int depth)
{
- int eqp = (depth == -1); /* -1 as depth means us eq, not equal. */
+ int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */
int la, lb, m, i, fill;
Lisp_Object *keys, *vals;
char *flags;
{
if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
{
- if ((eqp
- /* We narrowly escaped being Ebolified here. */
- ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
- : !internal_equal (v, vals [i], depth)))
+ if (eqp
+ /* We narrowly escaped being Ebolified here. */
+ ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
+ : !internal_equal (v, vals [i], depth))
/* a property in B has a different value than in A */
goto MISMATCH;
flags [i] = 1;
return value;
}
-void
-pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val)
-{
- Fput (sym, prop, Fpurecopy (val));
-}
-
DEFUN ("remprop", Fremprop, 2, 2, 0, /*
Remove from OBJECT's property list the property PROPNAME and its
value. OBJECT can be a symbol, face, extent, or string. Returns
\f
DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
-Store each element of ARRAY with ITEM.
+Destructively modify ARRAY by replacing each element with ITEM.
ARRAY is a vector, bit vector, or string.
*/
(array, item))
retry:
if (STRINGP (array))
{
- Emchar charval;
struct Lisp_String *s = XSTRING (array);
- Charcount len = string_char_length (s);
- Charcount i;
+ Bytecount old_bytecount = string_length (s);
+ Bytecount new_bytecount;
+ Bytecount item_bytecount;
+ Bufbyte item_buf[MAX_EMCHAR_LEN];
+ Bufbyte *p;
+ Bufbyte *end;
+
CHECK_CHAR_COERCE_INT (item);
CHECK_LISP_WRITEABLE (array);
- charval = XCHAR (item);
- for (i = 0; i < len; i++)
- set_string_char (s, i, charval);
+
+ item_bytecount = set_charptr_emchar (item_buf, XCHAR (item));
+ new_bytecount = item_bytecount * string_char_length (s);
+
+ resize_string (s, -1, new_bytecount - old_bytecount);
+
+ for (p = string_data (s), end = p + new_bytecount;
+ p < end;
+ p += item_bytecount)
+ memcpy (p, item_buf, item_bytecount);
+ *p = '\0';
+
bump_string_modiff (array);
}
else if (VECTORP (array))
}
\f
-/* This is the guts of all mapping functions.
- Apply fn to each element of seq, one by one,
- storing the results into elements of vals, a C vector of Lisp_Objects.
- leni is the length of vals, which should also be the length of seq.
+/* This is the guts of several mapping functions.
+ Apply FUNCTION to each element of SEQUENCE, one by one,
+ storing the results into elements of VALS, a C vector of Lisp_Objects.
+ LENI is the length of VALS, which should also be the length of SEQUENCE.
If VALS is a null pointer, do not accumulate the results. */
static void
-mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
+mapcar1 (size_t leni, Lisp_Object *vals,
+ Lisp_Object function, Lisp_Object sequence)
{
Lisp_Object result;
Lisp_Object args[2];
gcpro1.nvars = 0;
}
- args[0] = fn;
+ args[0] = function;
- if (LISTP (seq))
+ if (LISTP (sequence))
{
- for (i = 0; i < leni; i++)
+ /* A devious `function' could either:
+ - insert garbage into the list in front of us, causing XCDR to crash
+ - amputate the list behind us using (setcdr), causing the remaining
+ elts to lose their GCPRO status.
+
+ if (vals != 0) we avoid this by copying the elts into the
+ `vals' array. By a stroke of luck, `vals' is exactly large
+ enough to hold the elts left to be traversed as well as the
+ results computed so far.
+
+ if (vals == 0) we don't have any free space available and
+ don't want to eat up any more stack with alloca().
+ So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */
+
+ if (vals)
{
- args[1] = XCAR (seq);
- seq = XCDR (seq);
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ Lisp_Object *val = vals;
+ Lisp_Object elt;
+
+ LIST_LOOP_2 (elt, sequence)
+ *val++ = elt;
+
+ gcpro1.nvars = leni;
+
+ for (i = 0; i < leni; i++)
+ {
+ args[1] = vals[i];
+ vals[i] = Ffuncall (2, args);
+ }
+ }
+ else
+ {
+ Lisp_Object elt, tail;
+ struct gcpro ngcpro1;
+
+ NGCPRO1 (tail);
+
+ {
+ EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+ {
+ args[1] = elt;
+ Ffuncall (2, args);
+ }
+ }
+
+ NUNGCPRO;
}
}
- else if (VECTORP (seq))
+ else if (VECTORP (sequence))
{
- Lisp_Object *objs = XVECTOR_DATA (seq);
+ Lisp_Object *objs = XVECTOR_DATA (sequence);
for (i = 0; i < leni; i++)
{
args[1] = *objs++;
if (vals) vals[gcpro1.nvars++] = result;
}
}
- else if (STRINGP (seq))
+ else if (STRINGP (sequence))
{
- Bufbyte *p = XSTRING_DATA (seq);
- for (i = 0; i < leni; i++)
+ /* The string data of `sequence' might be relocated during GC. */
+ Bytecount slen = XSTRING_LENGTH (sequence);
+ Bufbyte *p = alloca_array (Bufbyte, slen);
+ Bufbyte *end = p + slen;
+
+ memcpy (p, XSTRING_DATA (sequence), slen);
+
+ while (p < end)
{
args[1] = make_char (charptr_emchar (p));
INC_CHARPTR (p);
if (vals) vals[gcpro1.nvars++] = result;
}
}
- else if (BIT_VECTORP (seq))
+ else if (BIT_VECTORP (sequence))
{
- struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
+ struct Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
for (i = 0; i < leni; i++)
{
args[1] = make_int (bit_vector_bit (v, i));
}
}
else
- abort(); /* cannot get here since Flength(seq) did not get an error */
+ abort(); /* cannot get here since Flength(sequence) did not get an error */
if (vals)
UNGCPRO;
}
DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
-Apply FN to each element of SEQ, and concat the results as strings.
-In between each pair of results, stick in SEP.
-Thus, " " as SEP results in spaces between the values returned by FN.
+Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.
+In between each pair of results, insert SEPARATOR. Thus, using " " as
+SEPARATOR results in spaces between the values returned by FUNCTION.
+SEQUENCE may be a list, a vector, a bit vector, or a string.
*/
- (fn, seq, sep))
+ (function, sequence, separator))
{
- size_t len = XINT (Flength (seq));
+ size_t len = XINT (Flength (sequence));
Lisp_Object *args;
int i;
struct gcpro gcpro1;
args = alloca_array (Lisp_Object, nargs);
- GCPRO1 (sep);
- mapcar1 (len, args, fn, seq);
+ GCPRO1 (separator);
+ mapcar1 (len, args, function, sequence);
UNGCPRO;
for (i = len - 1; i >= 0; i--)
args[i + i] = args[i];
for (i = 1; i < nargs; i += 2)
- args[i] = sep;
+ args[i] = separator;
return Fconcat (nargs, args);
}
DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE, and make a list of the results.
-The result is a list just as long as SEQUENCE.
+Apply FUNCTION to each element of SEQUENCE; return a list of the results.
+The result is a list of the same length as SEQUENCE.
SEQUENCE may be a list, a vector, a bit vector, or a string.
*/
- (fn, seq))
+ (function, sequence))
{
- size_t len = XINT (Flength (seq));
+ size_t len = XINT (Flength (sequence));
Lisp_Object *args = alloca_array (Lisp_Object, len);
- mapcar1 (len, args, fn, seq);
+ mapcar1 (len, args, function, sequence);
return Flist (len, args);
}
DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE, making a vector of the results.
+Apply FUNCTION to each element of SEQUENCE; return a vector of the results.
The result is a vector of the same length as SEQUENCE.
-SEQUENCE may be a list, a vector or a string.
+SEQUENCE may be a list, a vector, a bit vector, or a string.
*/
- (fn, seq))
+ (function, sequence))
{
- size_t len = XINT (Flength (seq));
+ size_t len = XINT (Flength (sequence));
Lisp_Object result = make_vector (len, Qnil);
struct gcpro gcpro1;
GCPRO1 (result);
- mapcar1 (len, XVECTOR_DATA (result), fn, seq);
+ mapcar1 (len, XVECTOR_DATA (result), function, sequence);
UNGCPRO;
return result;
}
-DEFUN ("mapc", Fmapc, 2, 2, 0, /*
+DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /*
Apply FUNCTION to each element of SEQUENCE.
SEQUENCE may be a list, a vector, a bit vector, or a string.
This function is like `mapcar' but does not accumulate the results,
which is more efficient if you do not use the results.
+
+The difference between this and `mapc' is that `mapc' supports all
+the spiffy Common Lisp arguments. You should normally use `mapc'.
*/
- (fn, seq))
+ (function, sequence))
{
- mapcar1 (XINT (Flength (seq)), 0, fn, seq);
+ mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
- return seq;
+ return sequence;
}
\f
\f
Lisp_Object Vfeatures;
-DEFUN ("featurep", Ffeaturep, 1, 2, 0, /*
+DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
Return non-nil if feature FEXP is present in this Emacs.
Use this to conditionalize execution of lisp code based on the
presence or absence of emacs or environment extensions.
for supporting multiple Emacs variants, lobby Richard Stallman at
<bug-gnu-emacs@prep.ai.mit.edu>.
*/
- (fexp, console))
+ (fexp))
{
#ifndef FEATUREP_SYNTAX
CHECK_SYMBOL (fexp);
if (SYMBOLP (fexp))
{
/* Original definition */
- return (NILP (Fmemq (fexp, Vfeatures))
- &&
- NILP (Fmemq (fexp,
- CONSOLE_FEATURES (decode_console (console)))))
- ? Qnil : Qt;
+ return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
}
else if (INTP (fexp) || FLOATP (fexp))
{
CHECK_SYMBOL (feature);
if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
-
tem = Fmemq (feature, Vfeatures);
if (NILP (tem))
Vfeatures = Fcons (feature, Vfeatures);
return feature;
}
-DEFUN ("provide-on-console", Fprovide_on_console, 2, 2, 0, /*
-Announce that FEATURE is a feature of the current Emacs.
-This function updates the value of `console-features' for the provided CONSOLE.
-*/
- (feature, console))
-{
- Lisp_Object tem;
- CHECK_SYMBOL (feature);
-
- if (SYMBOLP (console))
- {
- struct console_methods* meths = decode_console_type (console, ERROR_ME);
-
- tem = Fmemq (feature, CONMETH_FEATURES (meths));
- if (NILP (tem))
- CONMETH_FEATURES (meths) =
- Fcons (feature, CONMETH_FEATURES (meths));
- }
- else
- {
- struct console* pconsole;
- CHECK_CONSOLE (console);
-
- pconsole = decode_console (console);
- tem = Fmemq (feature, CONSOLE_FEATURES (pconsole));
- if (NILP (tem))
- CONSOLE_FEATURES (pconsole) =
- Fcons (feature, CONSOLE_FEATURES (pconsole));
- }
- return feature;
-}
-
DEFUN ("require", Frequire, 1, 2, 0, /*
If feature FEATURE is not loaded, load it from FILENAME.
If FEATURE is not a member of the list `features', then the feature
CHECK_SYMBOL (feature);
tem = Fmemq (feature, Vfeatures);
LOADHIST_ATTACH (Fcons (Qrequire, feature));
- if (!NILP (tem)
- ||
- !NILP (Fmemq (feature, CONSOLE_FEATURES
- (XCONSOLE (Fselected_console ())))))
+ if (!NILP (tem))
return feature;
else
{
DEFSUBR (Fnconc);
DEFSUBR (Fmapcar);
DEFSUBR (Fmapvector);
- DEFSUBR (Fmapc);
+ DEFSUBR (Fmapc_internal);
DEFSUBR (Fmapconcat);
DEFSUBR (Fload_average);
DEFSUBR (Ffeaturep);
DEFSUBR (Frequire);
DEFSUBR (Fprovide);
- DEFSUBR (Fprovide_on_console);
DEFSUBR (Fbase64_encode_region);
DEFSUBR (Fbase64_encode_string);
DEFSUBR (Fbase64_decode_region);