#include "buffer.h"
#include "bytecode.h"
+#include "commands.h"
#include "device.h"
#include "events.h"
#include "extents.h"
#include "frame.h"
#include "systime.h"
-#include "insdel.h"
-#include "lstream.h"
-#include "opaque.h"
/* NOTE: This symbol is also used in lread.c */
#define FEATUREP_SYNTAX
}
static int
-bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+bit_vector_equal (Lisp_Object o1, Lisp_Object o2, int depth)
{
- struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
- struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
+ struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (o1);
+ struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (o2);
return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
!memcmp (v1->bits, v2->bits,
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,
struct Lisp_Bit_Vector);
\f
DEFUN ("identity", Fidentity, 1, 1, 0, /*
return XINT (Flength (seq));
else
{
- struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq);
+ struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (seq);
- return (f->flags.interactivep ? COMPILED_INTERACTIVE :
- f->flags.domainp ? COMPILED_DOMAIN :
+ return (b->flags.interactivep ? COMPILED_INTERACTIVE :
+ b->flags.domainp ? COMPILED_DOMAIN :
COMPILED_DOC_STRING)
+ 1;
}
return make_int (XSTRING_CHAR_LENGTH (sequence));
else if (CONSP (sequence))
{
- int len;
- GET_EXTERNAL_LIST_LENGTH (sequence, len);
- return make_int (len);
+ Lisp_Object tail;
+ int i = 0;
+
+ EXTERNAL_LIST_LOOP (tail, sequence)
+ {
+ QUIT;
+ i++;
+ }
+
+ return make_int (i);
}
else if (VECTORP (sequence))
return make_int (XVECTOR_LENGTH (sequence));
}
}
+/* This does not check for quits. That is safe
+ since it must terminate. */
+
DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /*
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,
*/
(list))
{
- Lisp_Object hare, tortoise;
- int len;
+ Lisp_Object halftail = list; /* Used to detect circular lists. */
+ Lisp_Object tail;
+ int len = 0;
- for (hare = tortoise = list, len = 0;
- CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
- hare = XCDR (hare), len++)
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- if (len & 1)
- tortoise = XCDR (tortoise);
+ if (EQ (tail, halftail) && len != 0)
+ break;
+ len++;
+ if ((len & 1) == 0)
+ halftail = XCDR (halftail);
}
return make_int (len);
properly, it would still not work because strcoll() does not
handle multiple locales. This is the fundamental flaw in the
locale model. */
- {
- Bytecount bcend = charcount_to_bytecount (string_data (p1), end);
- /* Compare strings using collation order of locale. */
- /* Need to be tricky to handle embedded nulls. */
+ Bytecount bcend = charcount_to_bytecount (string_data (p1), end);
+ /* Compare strings using collation order of locale. */
+ /* Need to be tricky to handle embedded nulls. */
- for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1)
- {
- int val = strcoll ((char *) string_data (p1) + i,
- (char *) string_data (p2) + i);
- if (val < 0)
- return Qt;
- if (val > 0)
- return Qnil;
- }
- }
+ for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1)
+ {
+ int val = strcoll ((char *) string_data (p1) + i,
+ (char *) string_data (p2) + i);
+ if (val < 0)
+ return Qt;
+ if (val > 0)
+ return Qnil;
+ }
#else /* not I18N2, or MULE */
- {
- Bufbyte *ptr1 = string_data (p1);
- Bufbyte *ptr2 = string_data (p2);
-
- /* #### It is not really necessary to do this: We could compare
- byte-by-byte and still get a reasonable comparison, since this
- would compare characters with a charset in the same way. With
- a little rearrangement of the leading bytes, we could make most
- inter-charset comparisons work out the same, too; even if some
- don't, this is not a big deal because inter-charset comparisons
- aren't really well-defined anyway. */
- for (i = 0; i < end; i++)
- {
- if (charptr_emchar (ptr1) != charptr_emchar (ptr2))
- return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil;
- INC_CHARPTR (ptr1);
- INC_CHARPTR (ptr2);
- }
- }
+ /* #### It is not really necessary to do this: We could compare
+ byte-by-byte and still get a reasonable comparison, since this
+ would compare characters with a charset in the same way.
+ With a little rearrangement of the leading bytes, we could
+ make most inter-charset comparisons work out the same, too;
+ even if some don't, this is not a big deal because inter-charset
+ comparisons aren't really well-defined anyway. */
+ for (i = 0; i < end; i++)
+ {
+ if (string_char (p1, i) != string_char (p2, i))
+ return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil;
+ }
#endif /* not I18N2, or MULE */
/* Can't do i < len2 because then comparison between "foo" and "foo^@"
won't work right in I18N2 case */
return concat (nargs, args, c_bit_vector, 0);
}
-/* Copy a (possibly dotted) list. LIST must be a cons.
- Can't use concat (1, &alist, c_cons, 0) - doesn't handle dotted lists. */
-static Lisp_Object
-copy_list (Lisp_Object list)
-{
- Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list));
- Lisp_Object last = list_copy;
- Lisp_Object hare, tortoise;
- int len;
-
- for (tortoise = hare = XCDR (list), len = 1;
- CONSP (hare);
- hare = XCDR (hare), len++)
- {
- XCDR (last) = Fcons (XCAR (hare), XCDR (hare));
- last = XCDR (last);
-
- if (len < CIRCULAR_LIST_SUSPICION_LENGTH)
- continue;
- if (len & 1)
- tortoise = XCDR (tortoise);
- if (EQ (tortoise, hare))
- signal_circular_list_error (list);
- }
-
- return list_copy;
-}
-
-DEFUN ("copy-list", Fcopy_list, 1, 1, 0, /*
-Return a copy of list LIST, which may be a dotted list.
-The elements of LIST are not copied; they are shared
+DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /*
+Return a copy of a list, vector, bit vector or string.
+The elements of a list or vector are not copied; they are shared
with the original.
*/
- (list))
+ (arg))
{
again:
- if (NILP (list)) return list;
- if (CONSP (list)) return copy_list (list);
+ if (NILP (arg)) return arg;
+ /* We handle conses separately because concat() is big and hairy and
+ doesn't handle (copy-sequence '(a b . c)) and it's easier to redo this
+ than to fix concat() without worrying about breaking other things.
+ */
+ if (CONSP (arg))
+ {
+ Lisp_Object head = Fcons (XCAR (arg), XCDR (arg));
+ Lisp_Object tail = head;
- list = wrong_type_argument (Qlistp, list);
- goto again;
-}
+ for (arg = XCDR (arg); CONSP (arg); arg = XCDR (arg))
+ {
+ XCDR (tail) = Fcons (XCAR (arg), XCDR (arg));
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return head;
+ }
+ if (STRINGP (arg)) return concat (1, &arg, c_string, 0);
+ if (VECTORP (arg)) return concat (1, &arg, c_vector, 0);
+ if (BIT_VECTORP (arg)) return concat (1, &arg, c_bit_vector, 0);
-DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /*
-Return a copy of list, vector, bit vector or string SEQUENCE.
-The elements of a list or vector are not copied; they are shared
-with the original. SEQUENCE may be a dotted list.
-*/
- (sequence))
-{
- again:
- if (NILP (sequence)) return sequence;
- if (CONSP (sequence)) return copy_list (sequence);
- if (STRINGP (sequence)) return concat (1, &sequence, c_string, 0);
- if (VECTORP (sequence)) return concat (1, &sequence, c_vector, 0);
- if (BIT_VECTORP (sequence)) return concat (1, &sequence, c_bit_vector, 0);
-
- check_losing_bytecode ("copy-sequence", sequence);
- sequence = wrong_type_argument (Qsequencep, sequence);
+ check_losing_bytecode ("copy-sequence", arg);
+ arg = wrong_type_argument (Qsequencep, arg);
goto again;
}
(string, from, to))
{
Charcount ccfr, ccto;
- Bytecount bfr, blen;
+ Bytecount bfr, bto;
Lisp_Object val;
CHECK_STRING (string);
+ /* Historically, FROM could not be omitted. Whatever ... */
CHECK_INT (from);
get_string_range_char (string, from, to, &ccfr, &ccto,
GB_HISTORICAL_STRING_BEHAVIOR);
bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr);
- blen = charcount_to_bytecount (XSTRING_DATA (string) + bfr, ccto - ccfr);
- val = make_string (XSTRING_DATA (string) + bfr, blen);
+ bto = charcount_to_bytecount (XSTRING_DATA (string), ccto);
+ val = make_string (XSTRING_DATA (string) + bfr, bto - bfr);
/* Copy any applicable extent information into the new string: */
- copy_string_extents (val, string, 0, bfr, blen);
+ copy_string_extents (val, string, 0, bfr, bto - bfr);
return val;
}
args_out_of_range (sequence, n);
#endif
}
- else if (STRINGP (sequence) ||
- VECTORP (sequence) ||
- BIT_VECTORP (sequence))
+ else if (STRINGP (sequence)
+ || VECTORP (sequence)
+ || BIT_VECTORP (sequence))
return Faref (sequence, n);
#ifdef LOSING_BYTECODE
else if (COMPILED_FUNCTIONP (sequence))
}
/* Utter perversity */
{
- Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (sequence);
+ struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (sequence);
switch (idx)
{
case COMPILED_ARGLIST:
- return compiled_function_arglist (f);
- case COMPILED_INSTRUCTIONS:
- return compiled_function_instructions (f);
+ return b->arglist;
+ case COMPILED_BYTECODE:
+ return b->bytecodes;
case COMPILED_CONSTANTS:
- return compiled_function_constants (f);
+ return b->constants;
case COMPILED_STACK_DEPTH:
- return compiled_function_stack_depth (f);
+ return make_int (b->maxdepth);
case COMPILED_DOC_STRING:
- return compiled_function_documentation (f);
+ return compiled_function_documentation (b);
case COMPILED_DOMAIN:
- return compiled_function_domain (f);
+ return compiled_function_domain (b);
case COMPILED_INTERACTIVE:
- if (f->flags.interactivep)
- return compiled_function_interactive (f);
+ if (b->flags.interactivep)
+ return compiled_function_interactive (b);
/* if we return nil, can't tell interactive with no args
from noninteractive. */
goto lose;
}
}
-DEFUN ("last", Flast, 1, 2, 0, /*
-Return the tail of list LIST, of length N (default 1).
-LIST may be a dotted list, but not a circular list.
-Optional argument N must be a non-negative integer.
-If N is zero, then the atom that terminates the list is returned.
-If N is greater than the length of LIST, then LIST itself is returned.
-*/
- (list, n))
-{
- int int_n, count;
- Lisp_Object retval, tortoise, hare;
-
- CHECK_LIST (list);
-
- if (NILP (n))
- int_n = 1;
- else
- {
- CHECK_NATNUM (n);
- int_n = XINT (n);
- }
-
- for (retval = tortoise = hare = list, count = 0;
- CONSP (hare);
- hare = XCDR (hare),
- (int_n-- <= 0 ? ((void) (retval = XCDR (retval))) : (void)0),
- count++)
- {
- if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- if (count & 1)
- tortoise = XCDR (tortoise);
- if (EQ (hare, tortoise))
- signal_circular_list_error (list);
- }
-
- return retval;
-}
-
-DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
-Modify LIST to remove the last N (default 1) elements.
-If LIST has N or fewer elements, nil is returned and LIST is unmodified.
-*/
- (list, n))
-{
- int int_n;
-
- CHECK_LIST (list);
-
- if (NILP (n))
- int_n = 1;
- else
- {
- CHECK_NATNUM (n);
- int_n = XINT (n);
- }
-
- {
- Lisp_Object last_cons = list;
-
- EXTERNAL_LIST_LOOP_1 (list)
- {
- if (int_n-- < 0)
- last_cons = XCDR (last_cons);
- }
-
- if (int_n >= 0)
- return Qnil;
-
- XCDR (last_cons) = Qnil;
- return list;
- }
-}
-
-DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
-Return a copy of LIST with the last N (default 1) elements removed.
-If LIST has N or fewer elements, nil is returned.
-*/
- (list, n))
-{
- int int_n;
-
- CHECK_LIST (list);
-
- if (NILP (n))
- int_n = 1;
- else
- {
- CHECK_NATNUM (n);
- int_n = XINT (n);
- }
-
- {
- Lisp_Object retval = Qnil;
- Lisp_Object tail = list;
-
- EXTERNAL_LIST_LOOP_1 (list)
- {
- if (--int_n < 0)
- {
- retval = Fcons (XCAR (tail), retval);
- tail = XCDR (tail);
- }
- }
-
- return Fnreverse (retval);
- }
-}
-
DEFUN ("member", Fmember, 2, 2, 0, /*
Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
The value is actually the tail of LIST whose car is ELT.
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
- EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_equal (elt, list_elt, 0))
+ CONCHECK_CONS (tail);
+ if (internal_equal (elt, XCAR (tail), 0))
return tail;
+ QUIT;
}
return Qnil;
}
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
- EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_old_equal (elt, list_elt, 0))
+ CONCHECK_CONS (tail);
+ if (internal_old_equal (elt, XCAR (tail), 0))
return tail;
+ QUIT;
}
return Qnil;
}
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
- EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
return tail;
+ QUIT;
}
return Qnil;
}
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
- EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (HACKEQ_UNSAFE (elt, list_elt))
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), HACKEQ_UNSAFE (elt, tem))
return tail;
+ QUIT;
}
return Qnil;
}
Lisp_Object
memq_no_quit (Lisp_Object elt, Lisp_Object list)
{
- Lisp_Object list_elt, tail;
- LIST_LOOP_3 (list_elt, list, tail)
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
return tail;
}
return Qnil;
(key, list))
{
/* This function can GC. */
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_equal (key, elt_car, 0))
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (XCAR (elt), key, 0))
return elt;
+ QUIT;
}
return Qnil;
}
(key, list))
{
/* This function can GC. */
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_old_equal (key, elt_car, 0))
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_old_equal (XCAR (elt), key, 0))
return elt;
+ QUIT;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
return elt;
+ QUIT;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (HACKEQ_UNSAFE (key, elt_car))
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), HACKEQ_UNSAFE (key, tem)))
return elt;
+ QUIT;
}
return Qnil;
}
assq_no_quit (Lisp_Object key, Lisp_Object list)
{
/* This cannot GC. */
- Lisp_Object elt;
- LIST_LOOP_2 (elt, list)
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt_car = XCAR (elt);
- if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
- return elt;
+ REGISTER Lisp_Object tem, elt;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ return elt;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_equal (key, elt_cdr, 0))
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (XCDR (elt), key, 0))
return elt;
+ QUIT;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (internal_old_equal (key, elt_cdr, 0))
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_old_equal (XCDR (elt), key, 0))
return elt;
+ QUIT;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
return elt;
+ QUIT;
}
return Qnil;
}
*/
(key, list))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
{
- if (HACKEQ_UNSAFE (key, elt_cdr))
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), HACKEQ_UNSAFE (key, tem)))
return elt;
+ QUIT;
}
return Qnil;
}
-/* Like Frassq, but caller must ensure that LIST is properly
- nil-terminated and ebola-free. */
Lisp_Object
rassq_no_quit (Lisp_Object key, Lisp_Object list)
{
- Lisp_Object elt;
- LIST_LOOP_2 (elt, list)
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt_cdr = XCDR (elt);
- if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
return elt;
}
return Qnil;
*/
(elt, list))
{
- Lisp_Object list_elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (internal_equal (elt, list_elt, 0)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ CONCHECK_CONS (tail);
+ if (internal_equal (elt, XCAR (tail), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
*/
(elt, list))
{
- Lisp_Object list_elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (internal_old_equal (elt, list_elt, 0)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ CONCHECK_CONS (tail);
+ if (internal_old_equal (elt, XCAR (tail), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
*/
(elt, list))
{
- Lisp_Object list_elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
*/
(elt, list))
{
- Lisp_Object list_elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (HACKEQ_UNSAFE (elt, list_elt)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), HACKEQ_UNSAFE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
-/* Like Fdelq, but caller must ensure that LIST is properly
- nil-terminated and ebola-free. */
+/* no quit, no errors; be careful */
Lisp_Object
delq_no_quit (Lisp_Object elt, Lisp_Object list)
{
- Lisp_Object list_elt;
- LIST_LOOP_DELETE_IF (list_elt, list,
- (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
return list;
}
{
REGISTER Lisp_Object tail = list;
REGISTER Lisp_Object prev = Qnil;
+ struct Lisp_Cons *cons_to_free = NULL;
- while (!NILP (tail))
+ while (CONSP (tail))
{
- REGISTER Lisp_Object tem = XCAR (tail);
- if (EQ (elt, tem))
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
{
- Lisp_Object cons_to_free = tail;
if (NILP (prev))
list = XCDR (tail);
else
XCDR (prev) = XCDR (tail);
- tail = XCDR (tail);
- free_cons (XCONS (cons_to_free));
+ cons_to_free = XCONS (tail);
}
else
+ prev = tail;
+ tail = XCDR (tail);
+ if (cons_to_free)
{
- prev = tail;
- tail = XCDR (tail);
+ free_cons (cons_to_free);
+ cons_to_free = NULL;
}
}
return list;
*/
(key, list))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- internal_equal (key, XCAR (elt), 0)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (key, XCAR (elt), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
*/
(key, list))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
Lisp_Object
remassq_no_quit (Lisp_Object key, Lisp_Object list)
{
- Lisp_Object elt;
- LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
return list;
}
*/
(value, list))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- internal_equal (value, XCDR (elt), 0)));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (value, XCDR (elt), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
*/
(value, list))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (value, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
return list;
}
-/* Like Fremrassq, fast and unsafe; be careful */
+/* no quit, no errors; be careful */
+
Lisp_Object
remrassq_no_quit (Lisp_Object value, Lisp_Object list)
{
- Lisp_Object elt;
- LIST_LOOP_DELETE_IF (elt, list,
- (CONSP (elt) &&
- EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (value, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
return list;
}
while (!NILP (tail))
{
REGISTER Lisp_Object next;
+ QUIT;
CONCHECK_CONS (tail);
next = XCDR (tail);
XCDR (tail) = prev;
*/
(list))
{
- Lisp_Object reversed_list = Qnil;
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_2 (elt, list)
+ REGISTER Lisp_Object tail;
+ Lisp_Object new = Qnil;
+
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- reversed_list = Fcons (elt, reversed_list);
+ new = Fcons (XCAR (tail), new);
+ QUIT;
}
- return reversed_list;
+ if (!NILP (tail))
+ dead_wrong_type_argument (Qlistp, tail);
+ return new;
}
\f
static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
Lisp_Object
internal_plist_get (Lisp_Object plist, Lisp_Object property)
{
- Lisp_Object tail;
+ Lisp_Object tail = plist;
- for (tail = plist; !NILP (tail); tail = XCDR (XCDR (tail)))
+ for (; !NILP (tail); tail = XCDR (XCDR (tail)))
{
- if (EQ (XCAR (tail), property))
- return XCAR (XCDR (tail));
+ struct Lisp_Cons *c = XCONS (tail);
+ if (EQ (c->car, property))
+ return XCAR (c->cdr);
}
return Qunbound;
int
internal_remprop (Lisp_Object *plist, Lisp_Object property)
{
- Lisp_Object tail, prev;
+ Lisp_Object tail = *plist;
- for (tail = *plist, prev = Qnil;
- !NILP (tail);
+ if (NILP (tail))
+ return 0;
+
+ if (EQ (XCAR (tail), property))
+ {
+ *plist = XCDR (XCDR (tail));
+ return 1;
+ }
+
+ for (tail = XCDR (tail); !NILP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
- if (EQ (XCAR (tail), property))
+ struct Lisp_Cons *c = XCONS (tail);
+ if (EQ (XCAR (c->cdr), property))
{
- if (NILP (prev))
- *plist = XCDR (XCDR (tail));
- else
- XCDR (XCDR (prev)) = XCDR (XCDR (tail));
+ c->cdr = XCDR (XCDR (c->cdr));
return 1;
}
- else
- prev = tail;
}
return 0;
Lisp_Object *tortsave = *tortoise;
/* Note that our "fixing" may be more brutal than necessary,
- but it's the user's own problem, not ours, if they went in and
+ but it's the user's own problem, not ours. if they went in and
manually fucked up a plist. */
for (i = 0; i < 2; i++)
(plist, prop, default_))
{
Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME);
- return UNBOUNDP (val) ? default_ : val;
+ if (UNBOUNDP (val))
+ return default_;
+ return val;
}
DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
*/
(plist, prop))
{
- Lisp_Object val = Fplist_get (plist, prop, Qunbound);
- return UNBOUNDP (val) ? Qnil : Qt;
+ return UNBOUNDP (Fplist_get (plist, prop, Qunbound)) ? Qnil : Qt;
}
DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /*
/* external_remprop returns 1 if it removed any property.
We have to loop till it didn't remove anything, in case
the property occurs many times. */
- while (external_remprop (&XCDR (next), prop, 0, ERROR_ME))
- DO_NOTHING;
+ while (external_remprop (&XCDR (next), prop, 0, ERROR_ME));
plist = Fcdr (next);
}
Extract a value from a lax property list.
LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
using `equal' instead of `eq'. This function returns the value
corresponding to the given PROP, or DEFAULT if PROP is not one of the
properties on the list.
DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
Change value in LAX-PLIST of PROP to VAL.
LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
using `equal' instead of `eq'. PROP is usually a symbol and VAL is
any object. If PROP is already a property on the list, its value is
set to VAL, otherwise the new PROP VAL pair is added. The new plist
DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /*
Remove from LAX-PLIST the property PROP and its value.
LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
using `equal' instead of `eq'. PROP is usually a symbol. The new
plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be
sure to use the new value. The LAX-PLIST is modified by side effects.
DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /*
Return t if PROP has a value specified in LAX-PLIST.
LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
using `equal' instead of `eq'.
*/
(lax_plist, prop))
/* external_remprop returns 1 if it removed any property.
We have to loop till it didn't remove anything, in case
the property occurs many times. */
- while (external_remprop (&XCDR (next), prop, 1, ERROR_ME))
- DO_NOTHING;
+ while (external_remprop (&XCDR (next), prop, 1, ERROR_ME));
lax_plist = Fcdr (next);
}
*/
(object, propname, default_))
{
+ Lisp_Object val;
+
/* Various places in emacs call Fget() and expect it not to quit,
so don't quit. */
/* It's easiest to treat symbols specially because they may not
be an lrecord */
if (SYMBOLP (object))
- return symbol_getprop (object, propname, default_);
+ val = symbol_getprop (object, propname, default_);
else if (STRINGP (object))
- return string_getprop (XSTRING (object), propname, default_);
+ val = string_getprop (XSTRING (object), propname, default_);
else if (LRECORDP (object))
{
- CONST struct lrecord_implementation *imp
- = XRECORD_LHEADER_IMPLEMENTATION (object);
- if (!imp->getprop)
+ CONST struct lrecord_implementation
+ *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
+ if (imp->getprop)
+ {
+ val = (imp->getprop) (object, propname);
+ if (UNBOUNDP (val))
+ val = default_;
+ }
+ else
goto noprops;
-
- {
- Lisp_Object val = (imp->getprop) (object, propname);
- if (UNBOUNDP (val))
- val = default_;
- return val;
- }
}
else
{
noprops:
signal_simple_error ("Object type has no properties", object);
- return Qnil; /* Not reached */
}
+
+ return val;
}
DEFUN ("put", Fput, 3, 3, 0, /*
(object, propname, value))
{
CHECK_SYMBOL (propname);
- CHECK_LISP_WRITEABLE (object);
+ CHECK_IMPURE (object);
if (SYMBOLP (object))
symbol_putprop (object, propname, value);
int retval = 0;
CHECK_SYMBOL (propname);
- CHECK_LISP_WRITEABLE (object);
+ CHECK_IMPURE (object);
if (SYMBOLP (object))
retval = symbol_remprop (object, propname);
\f
int
-internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth)
{
if (depth > 200)
error ("Stack overflow in equal");
+#ifndef LRECORD_CONS
+ do_cdr:
+#endif
QUIT;
- if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
+ if (EQ_WITH_EBOLA_NOTICE (o1, o2))
return 1;
/* Note that (equal 20 20.0) should be nil */
- if (XTYPE (obj1) != XTYPE (obj2))
+ else if (XTYPE (o1) != XTYPE (o2))
return 0;
- if (LRECORDP (obj1))
+#ifndef LRECORD_CONS
+ else if (CONSP (o1))
+ {
+ if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1))
+ return 0;
+ o1 = XCDR (o1);
+ o2 = XCDR (o2);
+ goto do_cdr;
+ }
+#endif
+#ifndef LRECORD_VECTOR
+ else if (VECTORP (o1))
+ {
+ Lisp_Object *v1 = XVECTOR_DATA (o1);
+ Lisp_Object *v2 = XVECTOR_DATA (o2);
+ int len = XVECTOR_LENGTH (o1);
+ if (len != XVECTOR_LENGTH (o2))
+ return 0;
+ while (len--)
+ if (!internal_equal (*v1++, *v2++, depth + 1))
+ return 0;
+ return 1;
+ }
+#endif
+#ifndef LRECORD_STRING
+ else if (STRINGP (o1))
+ {
+ Bytecount len;
+ return (((len = XSTRING_LENGTH (o1)) == XSTRING_LENGTH (o2)) &&
+ !memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len));
+ }
+#endif
+ else if (LRECORDP (o1))
{
CONST struct lrecord_implementation
- *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
- *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
-
- return (imp1 == imp2) &&
+ *imp1 = XRECORD_LHEADER_IMPLEMENTATION (o1),
+ *imp2 = XRECORD_LHEADER_IMPLEMENTATION (o2);
+ if (imp1 != imp2)
+ return 0;
+ else if (imp1->equal == 0)
/* EQ-ness of the objects was noticed above */
- (imp1->equal && (imp1->equal) (obj1, obj2, depth));
+ return 0;
+ else
+ return (imp1->equal) (o1, o2, depth);
}
return 0;
but that seems unlikely. */
static int
-internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+internal_old_equal (Lisp_Object o1, Lisp_Object o2, int depth)
{
if (depth > 200)
error ("Stack overflow in equal");
+#ifndef LRECORD_CONS
+ do_cdr:
+#endif
QUIT;
- if (HACKEQ_UNSAFE (obj1, obj2))
+ if (HACKEQ_UNSAFE (o1, o2))
return 1;
/* Note that (equal 20 20.0) should be nil */
- if (XTYPE (obj1) != XTYPE (obj2))
+ else if (XTYPE (o1) != XTYPE (o2))
return 0;
+#ifndef LRECORD_CONS
+ else if (CONSP (o1))
+ {
+ if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1))
+ return 0;
+ o1 = XCDR (o1);
+ o2 = XCDR (o2);
+ goto do_cdr;
+ }
+#endif
+#ifndef LRECORD_VECTOR
+ else if (VECTORP (o1))
+ {
+ int indice;
+ int len = XVECTOR_LENGTH (o1);
+ if (len != XVECTOR_LENGTH (o2))
+ return 0;
+ for (indice = 0; indice < len; indice++)
+ {
+ if (!internal_old_equal (XVECTOR_DATA (o1) [indice],
+ XVECTOR_DATA (o2) [indice],
+ depth + 1))
+ return 0;
+ }
+ return 1;
+ }
+#endif
+#ifndef LRECORD_STRING
+ else if (STRINGP (o1))
+ {
+ Bytecount len = XSTRING_LENGTH (o1);
+ if (len != XSTRING_LENGTH (o2))
+ return 0;
+ if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len))
+ return 0;
+ return 1;
+ }
+#endif
+ else if (LRECORDP (o1))
+ {
+ CONST struct lrecord_implementation
+ *imp1 = XRECORD_LHEADER_IMPLEMENTATION (o1),
+ *imp2 = XRECORD_LHEADER_IMPLEMENTATION (o2);
+ if (imp1 != imp2)
+ return 0;
+ else if (imp1->equal == 0)
+ /* EQ-ness of the objects was noticed above */
+ return 0;
+ else
+ return (imp1->equal) (o1, o2, depth);
+ }
- return internal_equal (obj1, obj2, depth);
+ return 0;
}
DEFUN ("equal", Fequal, 2, 2, 0, /*
Vectors and strings are compared element by element.
Numbers are compared by value. Symbols must match exactly.
*/
- (obj1, obj2))
+ (o1, o2))
{
- return internal_equal (obj1, obj2, 0) ? Qt : Qnil;
+ return internal_equal (o1, o2, 0) ? Qt : Qnil;
}
DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
This function is provided only for byte-code compatibility with v19.
Do not use it.
*/
- (obj1, obj2))
+ (o1, o2))
{
- return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil;
+ return internal_old_equal (o1, o2, 0) ? Qt : Qnil;
}
\f
Charcount len = string_char_length (s);
Charcount i;
CHECK_CHAR_COERCE_INT (item);
- CHECK_LISP_WRITEABLE (array);
+ CHECK_IMPURE (array);
charval = XCHAR (item);
for (i = 0; i < len; i++)
set_string_char (s, i, charval);
{
Lisp_Object *p = XVECTOR_DATA (array);
int len = XVECTOR_LENGTH (array);
- CHECK_LISP_WRITEABLE (array);
+ CHECK_IMPURE (array);
while (len--)
*p++ = item;
}
int len = bit_vector_length (v);
int bit;
CHECK_BIT (item);
- CHECK_LISP_WRITEABLE (array);
+ CHECK_IMPURE (array);
bit = XINT (item);
while (len--)
set_bit_vector_bit (v, len, bit);
}
Lisp_Object
-nconc2 (Lisp_Object arg1, Lisp_Object arg2)
+nconc2 (Lisp_Object s1, Lisp_Object s2)
{
Lisp_Object args[2];
- struct gcpro gcpro1;
- args[0] = arg1;
- args[1] = arg2;
-
- GCPRO1 (args[0]);
- gcpro1.nvars = 2;
-
- RETURN_UNGCPRO (bytecode_nconc2 (args));
-}
-
-Lisp_Object
-bytecode_nconc2 (Lisp_Object *args)
-{
- retry:
-
- if (CONSP (args[0]))
- {
- /* (setcdr (last args[0]) args[1]) */
- Lisp_Object tortoise, hare;
- int count;
-
- for (hare = tortoise = args[0], count = 0;
- CONSP (XCDR (hare));
- hare = XCDR (hare), count++)
- {
- if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- if (count & 1)
- tortoise = XCDR (tortoise);
- if (EQ (hare, tortoise))
- signal_circular_list_error (args[0]);
- }
- XCDR (hare) = args[1];
- return args[0];
- }
- else if (NILP (args[0]))
- {
- return args[1];
- }
- else
- {
- args[0] = wrong_type_argument (args[0], Qlistp);
- goto retry;
- }
+ args[0] = s1;
+ args[1] = s2;
+ return Fnconc (2, args);
}
DEFUN ("nconc", Fnconc, 0, MANY, 0, /*
while (argnum < nargs)
{
- Lisp_Object val;
- retry:
- val = args[argnum];
+ Lisp_Object val = args[argnum];
if (CONSP (val))
{
- /* `val' is the first cons, which will be our return value. */
- /* `last_cons' will be the cons cell to mutate. */
- Lisp_Object last_cons = val;
- Lisp_Object tortoise = val;
+ /* Found the first cons, which will be our return value. */
+ Lisp_Object last = val;
for (argnum++; argnum < nargs; argnum++)
{
Lisp_Object next = args[argnum];
- retry_next:
+ redo:
if (CONSP (next) || argnum == nargs -1)
{
/* (setcdr (last val) next) */
- int count;
-
- for (count = 0;
- CONSP (XCDR (last_cons));
- last_cons = XCDR (last_cons), count++)
+ while (CONSP (XCDR (last)))
{
- if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- if (count & 1)
- tortoise = XCDR (tortoise);
- if (EQ (last_cons, tortoise))
- signal_circular_list_error (args[argnum-1]);
+ last = XCDR (last);
+ QUIT;
}
- XCDR (last_cons) = next;
+ XCDR (last) = next;
}
else if (NILP (next))
{
}
else
{
- next = wrong_type_argument (Qlistp, next);
- goto retry_next;
+ next = wrong_type_argument (next, Qlistp);
+ goto redo;
}
}
RETURN_UNGCPRO (val);
else if (argnum == nargs - 1) /* last arg? */
RETURN_UNGCPRO (val);
else
- {
- args[argnum] = wrong_type_argument (Qlistp, val);
- goto retry;
- }
+ args[argnum] = wrong_type_argument (val, Qlistp);
}
RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */
}
\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.
+ 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.
- If VALS is a null pointer, do not accumulate the results. */
+ 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 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
- Lisp_Object result;
- Lisp_Object args[2];
+ Lisp_Object tail;
+ Lisp_Object dummy = Qnil;
int i;
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object result;
+
+ GCPRO3 (dummy, fn, seq);
if (vals)
{
- GCPRO1 (vals[0]);
- gcpro1.nvars = 0;
+ /* Don't let vals contain any garbage when GC happens. */
+ for (i = 0; i < leni; i++)
+ vals[i] = Qnil;
+ gcpro1.var = vals;
+ gcpro1.nvars = leni;
}
- args[0] = fn;
+ /* 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 */
- if (LISTP (seq))
+ if (VECTORP (seq))
{
for (i = 0; i < leni; i++)
{
- args[1] = XCAR (seq);
- seq = XCDR (seq);
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ dummy = XVECTOR_DATA (seq)[i];
+ result = call1 (fn, dummy);
+ if (vals)
+ vals[i] = result;
}
}
- else if (VECTORP (seq))
+ else if (BIT_VECTORP (seq))
{
- Lisp_Object *objs = XVECTOR_DATA (seq);
+ struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
for (i = 0; i < leni; i++)
{
- args[1] = *objs++;
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ XSETINT (dummy, bit_vector_bit (v, i));
+ result = call1 (fn, dummy);
+ if (vals)
+ vals[i] = result;
}
}
else if (STRINGP (seq))
{
- Bufbyte *p = XSTRING_DATA (seq);
for (i = 0; i < leni; i++)
{
- args[1] = make_char (charptr_emchar (p));
- INC_CHARPTR (p);
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ result = call1 (fn, make_char (string_char (XSTRING (seq), i)));
+ if (vals)
+ vals[i] = result;
}
}
- else if (BIT_VECTORP (seq))
+ else /* Must be a list, since Flength did not get an error */
{
- struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
+ tail = seq;
for (i = 0; i < leni; i++)
{
- args[1] = make_int (bit_vector_bit (v, i));
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ result = call1 (fn, Fcar (tail));
+ if (vals)
+ vals[i] = result;
+ tail = Fcdr (tail);
}
}
- else
- abort(); /* cannot get here since Flength(seq) did not get an error */
- if (vals)
- UNGCPRO;
+ UNGCPRO;
}
DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
*/
(fn, seq, sep))
{
- size_t len = XINT (Flength (seq));
+ int len = XINT (Flength (seq));
Lisp_Object *args;
int i;
struct gcpro gcpro1;
*/
(fn, seq))
{
- size_t len = XINT (Flength (seq));
+ int len = XINT (Flength (seq));
Lisp_Object *args = alloca_array (Lisp_Object, len);
mapcar1 (len, args, fn, seq);
*/
(fn, seq))
{
- size_t len = XINT (Flength (seq));
+ int len = XINT (Flength (seq));
+ /* Ideally, this should call make_vector_internal, because we don't
+ need initialization. */
Lisp_Object result = make_vector (len, Qnil);
struct gcpro gcpro1;
\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
{
return unbind_to (speccount, feature);
}
}
-\f
-/* base64 encode/decode functions.
-
- Originally based on code from GNU recode. Ported to FSF Emacs by
- Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and
- subsequently heavily hacked by Hrvoje Niksic. */
-
-#define MIME_LINE_LENGTH 72
-
-#define IS_ASCII(Character) \
- ((Character) < 128)
-#define IS_BASE64(Character) \
- (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
-
-/* Table of characters coding the 64 values. */
-static char base64_value_to_char[64] =
-{
- 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */
- 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */
- 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */
- 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */
- 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */
- 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */
- '8', '9', '+', '/' /* 60-63 */
-};
-
-/* Table of base64 values for first 128 characters. */
-static short base64_char_to_value[128] =
-{
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */
- -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */
- 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */
- -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */
- 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */
- 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */
- 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */
- 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */
- 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */
- 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */
-};
-
-/* The following diagram shows the logical steps by which three octets
- get transformed into four base64 characters.
-
- .--------. .--------. .--------.
- |aaaaaabb| |bbbbcccc| |ccdddddd|
- `--------' `--------' `--------'
- 6 2 4 4 2 6
- .--------+--------+--------+--------.
- |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
- `--------+--------+--------+--------'
-
- .--------+--------+--------+--------.
- |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
- `--------+--------+--------+--------'
-
- The octets are divided into 6 bit chunks, which are then encoded into
- base64 characters. */
-
-#define ADVANCE_INPUT(c, stream) \
- ((ec = Lstream_get_emchar (stream)) == -1 ? 0 : \
- ((ec > 255) ? \
- (signal_simple_error ("Non-ascii character in base64 input", \
- make_char (ec)), 0) \
- : (c = (Bufbyte)ec), 1))
-
-static Bytind
-base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break)
-{
- EMACS_INT counter = 0;
- Bufbyte *e = to;
- Emchar ec;
- unsigned int value;
-
- while (1)
- {
- Bufbyte c;
- if (!ADVANCE_INPUT (c, istream))
- break;
-
- /* Wrap line every 76 characters. */
- if (line_break)
- {
- if (counter < MIME_LINE_LENGTH / 4)
- counter++;
- else
- {
- *e++ = '\n';
- counter = 1;
- }
- }
-
- /* Process first byte of a triplet. */
- *e++ = base64_value_to_char[0x3f & c >> 2];
- value = (0x03 & c) << 4;
-
- /* Process second byte of a triplet. */
- if (!ADVANCE_INPUT (c, istream))
- {
- *e++ = base64_value_to_char[value];
- *e++ = '=';
- *e++ = '=';
- break;
- }
-
- *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
- value = (0x0f & c) << 2;
-
- /* Process third byte of a triplet. */
- if (!ADVANCE_INPUT (c, istream))
- {
- *e++ = base64_value_to_char[value];
- *e++ = '=';
- break;
- }
-
- *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
- *e++ = base64_value_to_char[0x3f & c];
- }
-
- return e - to;
-}
-#undef ADVANCE_INPUT
-
-/* Get next character from the stream, except that non-base64
- characters are ignored. This is in accordance with rfc2045. EC
- should be an Emchar, so that it can hold -1 as the value for EOF. */
-#define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \
- ec = Lstream_get_emchar (stream); \
- ++streampos; \
- /* IS_BASE64 may not be called with negative arguments so check for \
- EOF first. */ \
- if (ec < 0 || IS_BASE64 (ec) || ec == '=') \
- break; \
-} while (1)
-
-#define STORE_BYTE(pos, val, ccnt) do { \
- pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \
- ++ccnt; \
-} while (0)
-
-static Bytind
-base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr)
-{
- Charcount ccnt = 0;
- Bufbyte *e = to;
- EMACS_INT streampos = 0;
-
- while (1)
- {
- Emchar ec;
- unsigned long value;
-
- /* Process first byte of a quadruplet. */
- ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
- if (ec < 0)
- break;
- if (ec == '=')
- signal_simple_error ("Illegal `=' character while decoding base64",
- make_int (streampos));
- value = base64_char_to_value[ec] << 18;
-
- /* Process second byte of a quadruplet. */
- ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
- if (ec < 0)
- error ("Premature EOF while decoding base64");
- if (ec == '=')
- signal_simple_error ("Illegal `=' character while decoding base64",
- make_int (streampos));
- value |= base64_char_to_value[ec] << 12;
- STORE_BYTE (e, value >> 16, ccnt);
-
- /* Process third byte of a quadruplet. */
- ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
- if (ec < 0)
- error ("Premature EOF while decoding base64");
-
- if (ec == '=')
- {
- ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
- if (ec < 0)
- error ("Premature EOF while decoding base64");
- if (ec != '=')
- signal_simple_error ("Padding `=' expected but not found while decoding base64",
- make_int (streampos));
- continue;
- }
-
- value |= base64_char_to_value[ec] << 6;
- STORE_BYTE (e, 0xff & value >> 8, ccnt);
-
- /* Process fourth byte of a quadruplet. */
- ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
- if (ec < 0)
- error ("Premature EOF while decoding base64");
- if (ec == '=')
- continue;
-
- value |= base64_char_to_value[ec];
- STORE_BYTE (e, 0xff & value, ccnt);
- }
-
- *ccptr = ccnt;
- return e - to;
-}
-#undef ADVANCE_INPUT
-#undef ADVANCE_INPUT_IGNORE_NONBASE64
-#undef STORE_BYTE
-
-static Lisp_Object
-free_malloced_ptr (Lisp_Object unwind_obj)
-{
- void *ptr = (void *)get_opaque_ptr (unwind_obj);
- xfree (ptr);
- free_opaque_ptr (unwind_obj);
- return Qnil;
-}
-
-/* Don't use alloca for regions larger than this, lest we overflow
- the stack. */
-#define MAX_ALLOCA 65536
-
-/* We need to setup proper unwinding, because there is a number of
- ways these functions can blow up, and we don't want to have memory
- leaks in those cases. */
-#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \
- size_t XOA_len = (len); \
- if (XOA_len > MAX_ALLOCA) \
- { \
- ptr = xnew_array (type, XOA_len); \
- record_unwind_protect (free_malloced_ptr, \
- make_opaque_ptr ((void *)ptr)); \
- } \
- else \
- ptr = alloca_array (type, XOA_len); \
-} while (0)
-
-#define XMALLOC_UNBIND(ptr, len, speccount) do { \
- if ((len) > MAX_ALLOCA) \
- unbind_to (speccount, Qnil); \
-} while (0)
-
-DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /*
-Base64-encode the region between BEG and END.
-Return the length of the encoded text.
-Optional third argument NO-LINE-BREAK means do not break long lines
-into shorter lines.
-*/
- (beg, end, no_line_break))
-{
- Bufbyte *encoded;
- Bytind encoded_length;
- Charcount allength, length;
- struct buffer *buf = current_buffer;
- Bufpos begv, zv, old_pt = BUF_PT (buf);
- Lisp_Object input;
- int speccount = specpdl_depth();
-
- get_buffer_range_char (buf, beg, end, &begv, &zv, 0);
- barf_if_buffer_read_only (buf, begv, zv);
-
- /* We need to allocate enough room for encoding the text.
- We need 33 1/3% more space, plus a newline every 76
- characters, and then we round up. */
- length = zv - begv;
- allength = length + length/3 + 1;
- allength += allength / MIME_LINE_LENGTH + 1 + 6;
-
- input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
- /* We needn't multiply allength with MAX_EMCHAR_LEN because all the
- base64 characters will be single-byte. */
- XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte);
- encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
- NILP (no_line_break));
- if (encoded_length > allength)
- abort ();
- Lstream_delete (XLSTREAM (input));
-
- /* Now we have encoded the region, so we insert the new contents
- and delete the old. (Insert first in order to preserve markers.) */
- buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0);
- XMALLOC_UNBIND (encoded, allength, speccount);
- buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0);
-
- /* Simulate FSF Emacs implementation of this function: if point was
- in the region, place it at the beginning. */
- if (old_pt >= begv && old_pt < zv)
- BUF_SET_PT (buf, begv);
-
- /* We return the length of the encoded text. */
- return make_int (encoded_length);
-}
-
-DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /*
-Base64 encode STRING and return the result.
-*/
- (string, no_line_break))
-{
- Charcount allength, length;
- Bytind encoded_length;
- Bufbyte *encoded;
- Lisp_Object input, result;
- int speccount = specpdl_depth();
-
- CHECK_STRING (string);
-
- length = XSTRING_CHAR_LENGTH (string);
- allength = length + length/3 + 1;
- allength += allength / MIME_LINE_LENGTH + 1 + 6;
-
- input = make_lisp_string_input_stream (string, 0, -1);
- XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte);
- encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
- NILP (no_line_break));
- if (encoded_length > allength)
- abort ();
- Lstream_delete (XLSTREAM (input));
- result = make_string (encoded, encoded_length);
- XMALLOC_UNBIND (encoded, allength, speccount);
- return result;
-}
-
-DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /*
-Base64-decode the region between BEG and END.
-Return the length of the decoded text.
-If the region can't be decoded, return nil and don't modify the buffer.
-Characters out of the base64 alphabet are ignored.
-*/
- (beg, end))
-{
- struct buffer *buf = current_buffer;
- Bufpos begv, zv, old_pt = BUF_PT (buf);
- Bufbyte *decoded;
- Bytind decoded_length;
- Charcount length, cc_decoded_length;
- Lisp_Object input;
- int speccount = specpdl_depth();
-
- get_buffer_range_char (buf, beg, end, &begv, &zv, 0);
- barf_if_buffer_read_only (buf, begv, zv);
-
- length = zv - begv;
-
- input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
- /* We need to allocate enough room for decoding the text. */
- XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte);
- decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length);
- if (decoded_length > length * MAX_EMCHAR_LEN)
- abort ();
- Lstream_delete (XLSTREAM (input));
- /* Now we have decoded the region, so we insert the new contents
- and delete the old. (Insert first in order to preserve markers.) */
- BUF_SET_PT (buf, begv);
- buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0);
- XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
- buffer_delete_range (buf, begv + cc_decoded_length,
- zv + cc_decoded_length, 0);
-
- /* Simulate FSF Emacs implementation of this function: if point was
- in the region, place it at the beginning. */
- if (old_pt >= begv && old_pt < zv)
- BUF_SET_PT (buf, begv);
-
- return make_int (cc_decoded_length);
-}
-
-DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /*
-Base64-decode STRING and return the result.
-Characters out of the base64 alphabet are ignored.
-*/
- (string))
-{
- Bufbyte *decoded;
- Bytind decoded_length;
- Charcount length, cc_decoded_length;
- Lisp_Object input, result;
- int speccount = specpdl_depth();
-
- CHECK_STRING (string);
-
- length = XSTRING_CHAR_LENGTH (string);
- /* We need to allocate enough room for decoding the text. */
- XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte);
-
- input = make_lisp_string_input_stream (string, 0, -1);
- decoded_length = base64_decode_1 (XLSTREAM (input), decoded,
- &cc_decoded_length);
- if (decoded_length > length * MAX_EMCHAR_LEN)
- abort ();
- Lstream_delete (XLSTREAM (input));
-
- result = make_string (decoded, decoded_length);
- XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
- return result;
-}
\f
Lisp_Object Qyes_or_no_p;
DEFSUBR (Fconcat);
DEFSUBR (Fvconcat);
DEFSUBR (Fbvconcat);
- DEFSUBR (Fcopy_list);
DEFSUBR (Fcopy_sequence);
DEFSUBR (Fcopy_alist);
DEFSUBR (Fcopy_tree);
DEFSUBR (Fnthcdr);
DEFSUBR (Fnth);
DEFSUBR (Felt);
- DEFSUBR (Flast);
- DEFSUBR (Fbutlast);
- DEFSUBR (Fnbutlast);
DEFSUBR (Fmember);
DEFSUBR (Fold_member);
DEFSUBR (Fmemq);
DEFSUBR (Ffeaturep);
DEFSUBR (Frequire);
DEFSUBR (Fprovide);
- DEFSUBR (Fprovide_on_console);
- DEFSUBR (Fbase64_encode_region);
- DEFSUBR (Fbase64_encode_string);
- DEFSUBR (Fbase64_decode_region);
- DEFSUBR (Fbase64_decode_string);
}
void
Used by `featurep' and `require', and altered by `provide'.
*/ );
Vfeatures = Qnil;
-
- Fprovide (intern ("base64"));
}