/* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
Free Software Foundation, Inc.
+ Copyright (C) 2000 Ben Wing.
This file is part of XEmacs.
#endif /* LISP_FLOAT_TYPE */
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+#ifdef UTF2000
+Lisp_Object Qunloaded;
+#endif
Lisp_Object Qerror_conditions, Qerror_message;
-Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
-Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
-Lisp_Object Qvoid_function, Qcyclic_function_indirection;
-Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
+Lisp_Object Qerror, Qquit, Qsyntax_error, Qinvalid_read_syntax;
+Lisp_Object Qlist_formation_error;
Lisp_Object Qmalformed_list, Qmalformed_property_list;
Lisp_Object Qcircular_list, Qcircular_property_list;
-Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
+Lisp_Object Qinvalid_argument, Qwrong_type_argument, Qargs_out_of_range;
+Lisp_Object Qwrong_number_of_arguments, Qinvalid_function, Qno_catch;
+Lisp_Object Qinternal_error, Qinvalid_state;
+Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
+Lisp_Object Qvoid_function, Qcyclic_function_indirection;
+Lisp_Object Qinvalid_operation, Qinvalid_change;
+Lisp_Object Qsetting_constant;
+Lisp_Object Qediting_error;
+Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
Lisp_Object Qio_error, Qend_of_file;
Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
-Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp;
+Lisp_Object Qintegerp, Qnatnump, Qsymbolp;
Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
Lisp_Object Qconsp, Qsubrp;
Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp;
Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p;
-Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p;
-Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore;
+Lisp_Object Qnumberp, Qnumber_char_or_marker_p;
+Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
Lisp_Object Qfloatp;
int debug_issue_ebola_notices;
-int debug_ebola_backtrace_length;
+Fixnum debug_ebola_backtrace_length;
int
eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2)
&& ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))))
{
/* #### It would be really nice if this were a proper warning
- instead of brain-dead print ro Qexternal_debugging_output. */
+ instead of brain-dead print to Qexternal_debugging_output. */
write_c_string ("Comparison between integer and character is constant nil (",
Qexternal_debugging_output);
Fprinc (obj1, Qexternal_debugging_output);
}
void
-check_int_range (int val, int min, int max)
+check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
{
if (val < min || val > max)
args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
/* On a few machines, XINT can only be done by calling this. */
/* XEmacs: only used by m/convex.h */
-int sign_extend_lisp_int (EMACS_INT num);
-int
+EMACS_INT sign_extend_lisp_int (EMACS_INT num);
+EMACS_INT
sign_extend_lisp_int (EMACS_INT num)
{
- if (num & (1L << (VALBITS - 1)))
- return num | ((-1L) << VALBITS);
+ if (num & (1L << (INT_VALBITS - 1)))
+ return num | ((-1L) << INT_VALBITS);
else
- return num & ((1L << VALBITS) - 1);
+ return num & (EMACS_INT) ((1UL << INT_VALBITS) - 1);
}
\f
DEFUN ("eq", Feq, 2, 2, 0, /*
Return t if the two args are the same Lisp object.
*/
- (obj1, obj2))
+ (object1, object2))
{
- return EQ_WITH_EBOLA_NOTICE (obj1, obj2) ? Qt : Qnil;
+ return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil;
}
DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
Do not use this function!
*/
- (obj1, obj2))
+ (object1, object2))
{
/* #### blasphemy */
- return HACKEQ_UNSAFE (obj1, obj2) ? Qt : Qnil;
+ return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil;
}
DEFUN ("null", Fnull, 1, 1, 0, /*
}
DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /*
-Return t if OBJECT is a non-dotted, i.e. nil-terminated, list.
+Return t if OBJECT is an acyclic, nil-terminated (ie, not dotted), list.
*/
(object))
{
}
DEFUN ("subr-interactive", Fsubr_interactive, 1, 1, 0, /*
-Return the interactive spec of the subr object, or nil.
+Return the interactive spec of the subr object SUBR, or nil.
If non-nil, the return value will be a list whose first element is
`interactive' and whose second element is the interactive spec.
*/
(subr))
{
- CONST char *prompt;
+ const char *prompt;
CHECK_SUBR (subr);
prompt = XSUBR (subr)->prompt;
return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
}
DEFUN ("char-to-int", Fchar_to_int, 1, 1, 0, /*
-Convert a character into an equivalent integer.
+Convert CHARACTER into an equivalent integer.
The resulting integer will always be non-negative. The integers in
the range 0 - 255 map to characters as follows:
may vary depending on the particular version of XEmacs, the order in which
character sets were loaded, etc., and you should not depend on them.
*/
- (ch))
+ (character))
{
- CHECK_CHAR (ch);
- return make_int (XCHAR (ch));
+ CHECK_CHAR (character);
+ return make_int (XCHAR (character));
}
DEFUN ("int-to-char", Fint_to_char, 1, 1, 0, /*
-Convert an integer into the equivalent character.
+Convert integer INTEGER into the equivalent character.
Not all integers correspond to valid characters; use `char-int-p' to
determine whether this is the case. If the integer cannot be converted,
nil is returned.
{
return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil;
}
+
+DEFUN ("char-ref-p", Fchar_ref_p, 1, 1, 0, /*
+Return t if OBJECT is a character-reference.
+*/
+ (object))
+{
+ return CONSP (object) && KEYWORDP (XCAR (object)) ? Qt : Qnil;
+}
\f
DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
Return t if OBJECT is an integer.
}
DEFUN ("setcar", Fsetcar, 2, 2, 0, /*
-Set the car of CONSCELL to be NEWCAR. Return NEWCAR.
+Set the car of CONS-CELL to be NEWCAR. Return NEWCAR.
*/
- (conscell, newcar))
+ (cons_cell, newcar))
{
- if (!CONSP (conscell))
- conscell = wrong_type_argument (Qconsp, conscell);
+ if (!CONSP (cons_cell))
+ cons_cell = wrong_type_argument (Qconsp, cons_cell);
- CHECK_LISP_WRITEABLE (conscell);
- XCAR (conscell) = newcar;
+ XCAR (cons_cell) = newcar;
return newcar;
}
DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
-Set the cdr of CONSCELL to be NEWCDR. Return NEWCDR.
+Set the cdr of CONS-CELL to be NEWCDR. Return NEWCDR.
*/
- (conscell, newcdr))
+ (cons_cell, newcdr))
{
- if (!CONSP (conscell))
- conscell = wrong_type_argument (Qconsp, conscell);
+ if (!CONSP (cons_cell))
+ cons_cell = wrong_type_argument (Qconsp, cons_cell);
- CHECK_LISP_WRITEABLE (conscell);
- XCDR (conscell) = newcdr;
+ XCDR (cons_cell) = newcdr;
return newcdr;
}
\f
return it. If there is a cycle in the function chain, signal a
cyclic-function-indirection error.
- This is like Findirect_function, except that it doesn't signal an
- error if the chain ends up unbound. */
+ This is like Findirect_function when VOID_FUNCTION_ERRORP is true.
+ When VOID_FUNCTION_ERRORP is false, no error is signaled if the end
+ of the chain ends up being Qunbound. */
Lisp_Object
-indirect_function (Lisp_Object object, int errorp)
+indirect_function (Lisp_Object object, int void_function_errorp)
{
#define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16
Lisp_Object tortoise, hare;
return Fsignal (Qcyclic_function_indirection, list1 (object));
}
- if (errorp && UNBOUNDP (hare))
- signal_void_function_error (object);
+ if (void_function_errorp && UNBOUNDP (hare))
+ return signal_void_function_error (object);
return hare;
}
*/
(array, index_))
{
- int idx;
+ EMACS_INT idx;
retry:
*/
(array, index_, newval))
{
- int idx;
+ EMACS_INT idx;
retry:
if (idx < 0) goto range_error;
- CHECK_LISP_WRITEABLE (array);
-
if (VECTORP (array))
{
if (idx >= XVECTOR_LENGTH (array)) goto range_error;
}
}
-static int
+static EMACS_INT
integer_char_or_marker_to_int (Lisp_Object obj)
{
retry:
\f
DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /*
-Convert NUM to a string by printing it in decimal.
+Convert NUMBER to a string by printing it in decimal.
Uses a minus sign if negative.
-NUM may be an integer or a floating point number.
+NUMBER may be an integer or a floating point number.
*/
- (num))
+ (number))
{
char buffer[VALBITS];
- CHECK_INT_OR_FLOAT (num);
+ CHECK_INT_OR_FLOAT (number);
#ifdef LISP_FLOAT_TYPE
- if (FLOATP (num))
+ if (FLOATP (number))
{
char pigbuf[350]; /* see comments in float_to_string */
- float_to_string (pigbuf, XFLOAT_DATA (num));
+ float_to_string (pigbuf, XFLOAT_DATA (number));
return build_string (pigbuf);
}
#endif /* LISP_FLOAT_TYPE */
- long_to_string (buffer, XINT (num));
+ long_to_string (buffer, XINT (number));
return build_string (buffer);
}
}
DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /*
-Convert STRING to a number by parsing it as a decimal number.
+Convert STRING to a number by parsing it as a number in base BASE.
This parses both integers and floating point numbers.
It ignores leading spaces and tabs.
-If BASE, interpret STRING as a number in that base. If BASE isn't
-present, base 10 is used. BASE must be between 2 and 16 (inclusive).
+If BASE is nil or omitted, base 10 is used.
+BASE must be an integer between 2 and 16 (inclusive).
Floating point numbers always use base 10.
*/
(string, base))
p++;
#ifdef LISP_FLOAT_TYPE
- if (isfloat_string (p))
+ if (isfloat_string (p) && b == 10)
return make_float (atof (p));
#endif /* LISP_FLOAT_TYPE */
}
else
{
- int digit, negative = 1;
+ int negative = 1;
EMACS_INT v = 0;
if (*p == '-')
p++;
while (1)
{
- digit = digit_to_number (*p++, b);
+ int digit = digit_to_number (*p++, b);
if (digit < 0)
break;
v = v * b + digit;
Return remainder of first arg divided by second.
Both must be integers, characters or markers.
*/
- (num1, num2))
+ (number1, number2))
{
- int ival1 = integer_char_or_marker_to_int (num1);
- int ival2 = integer_char_or_marker_to_int (num2);
+ EMACS_INT ival1 = integer_char_or_marker_to_int (number1);
+ EMACS_INT ival2 = integer_char_or_marker_to_int (number2);
if (ival2 == 0)
Fsignal (Qarith_error, Qnil);
}
#endif /* LISP_FLOAT_TYPE */
{
- int ival;
+ EMACS_INT ival;
if (iod2.c.ival == 0) goto divide_by_zero;
ival = iod1.c.ival % iod2.c.ival;
static Lisp_Object encode_weak_list_type (enum weak_list_type type);
static Lisp_Object
-mark_weak_list (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_weak_list (Lisp_Object obj)
{
return Qnil; /* nichts ist gemarkt */
}
}
static const struct lrecord_description weak_list_description[] = {
- { XD_LISP_OBJECT, offsetof(struct weak_list, list), 1 },
- { XD_LISP_OBJECT, offsetof(struct weak_list, next_weak), 1 },
+ { XD_LISP_OBJECT, offsetof (struct weak_list, list) },
+ { XD_LO_LINK, offsetof (struct weak_list, next_weak) },
{ XD_END }
};
*/
int
-finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
- void (*markobj) (Lisp_Object))
+finish_marking_weak_lists (void)
{
Lisp_Object rest;
int did_mark = 0;
for (rest = Vall_weak_lists;
- !GC_NILP (rest);
+ !NILP (rest);
rest = XWEAK_LIST (rest)->next_weak)
{
Lisp_Object rest2;
enum weak_list_type type = XWEAK_LIST (rest)->type;
- if (! obj_marked_p (rest))
+ if (! marked_p (rest))
/* The weak list is probably garbage. Ignore it. */
continue;
/* We need to be trickier since we're inside of GC;
use CONSP instead of !NILP in case of user-visible
imperfect lists */
- GC_CONSP (rest2);
+ CONSP (rest2);
rest2 = XCDR (rest2))
{
Lisp_Object elem;
(either because of an external pointer or because of
a previous call to this function), and likewise for all
the rest of the elements in the list, so we can stop now. */
- if (obj_marked_p (rest2))
+ if (marked_p (rest2))
break;
elem = XCAR (rest2);
switch (type)
{
case WEAK_LIST_SIMPLE:
- if (obj_marked_p (elem))
+ if (marked_p (elem))
need_to_mark_cons = 1;
break;
case WEAK_LIST_ASSOC:
- if (!GC_CONSP (elem))
+ if (!CONSP (elem))
{
/* just leave bogus elements there */
need_to_mark_cons = 1;
need_to_mark_elem = 1;
}
- else if (obj_marked_p (XCAR (elem)) &&
- obj_marked_p (XCDR (elem)))
+ else if (marked_p (XCAR (elem)) &&
+ marked_p (XCDR (elem)))
{
need_to_mark_cons = 1;
/* We still need to mark elem, because it's
break;
case WEAK_LIST_KEY_ASSOC:
- if (!GC_CONSP (elem))
+ if (!CONSP (elem))
{
/* just leave bogus elements there */
need_to_mark_cons = 1;
need_to_mark_elem = 1;
}
- else if (obj_marked_p (XCAR (elem)))
+ else if (marked_p (XCAR (elem)))
{
need_to_mark_cons = 1;
/* We still need to mark elem and XCDR (elem);
break;
case WEAK_LIST_VALUE_ASSOC:
- if (!GC_CONSP (elem))
+ if (!CONSP (elem))
+ {
+ /* just leave bogus elements there */
+ need_to_mark_cons = 1;
+ need_to_mark_elem = 1;
+ }
+ else if (marked_p (XCDR (elem)))
+ {
+ need_to_mark_cons = 1;
+ /* We still need to mark elem and XCAR (elem);
+ marking elem does both */
+ need_to_mark_elem = 1;
+ }
+ break;
+
+ case WEAK_LIST_FULL_ASSOC:
+ if (!CONSP (elem))
{
/* just leave bogus elements there */
need_to_mark_cons = 1;
need_to_mark_elem = 1;
}
- else if (obj_marked_p (XCDR (elem)))
+ else if (marked_p (XCAR (elem)) ||
+ marked_p (XCDR (elem)))
{
need_to_mark_cons = 1;
/* We still need to mark elem and XCAR (elem);
break;
default:
- abort ();
+ ABORT ();
}
- if (need_to_mark_elem && ! obj_marked_p (elem))
+ if (need_to_mark_elem && ! marked_p (elem))
{
- markobj (elem);
+ mark_object (elem);
did_mark = 1;
}
/* We also need to mark the cons that holds the elem or
- assoc-pair. We do *not* want to call (markobj) here
+ assoc-pair. We do *not* want to call (mark_object) here
because that will mark the entire list; we just want to
mark the cons itself.
*/
if (need_to_mark_cons)
{
- struct Lisp_Cons *ptr = XCONS (rest2);
- if (!CONS_MARKED_P (ptr))
+ Lisp_Cons *c = XCONS (rest2);
+ if (!CONS_MARKED_P (c))
{
- MARK_CONS (ptr);
+ MARK_CONS (c);
did_mark = 1;
}
}
/* In case of imperfect list, need to mark the final cons
because we're not removing it */
- if (!GC_NILP (rest2) && ! obj_marked_p (rest2))
+ if (!NILP (rest2) && ! marked_p (rest2))
{
- markobj (rest2);
+ mark_object (rest2);
did_mark = 1;
}
}
}
void
-prune_weak_lists (int (*obj_marked_p) (Lisp_Object))
+prune_weak_lists (void)
{
Lisp_Object rest, prev = Qnil;
for (rest = Vall_weak_lists;
- !GC_NILP (rest);
+ !NILP (rest);
rest = XWEAK_LIST (rest)->next_weak)
{
- if (! (obj_marked_p (rest)))
+ if (! (marked_p (rest)))
{
/* This weak list itself is garbage. Remove it from the list. */
- if (GC_NILP (prev))
+ if (NILP (prev))
Vall_weak_lists = XWEAK_LIST (rest)->next_weak;
else
XWEAK_LIST (prev)->next_weak =
/* We need to be trickier since we're inside of GC;
use CONSP instead of !NILP in case of user-visible
imperfect lists */
- GC_CONSP (rest2);)
+ CONSP (rest2);)
{
/* It suffices to check the cons for marking,
regardless of the type of weak list:
have been marked in finish_marking_weak_lists().
-- otherwise, it's not marked and should disappear.
*/
- if (! obj_marked_p (rest2))
+ if (! marked_p (rest2))
{
/* bye bye :-( */
- if (GC_NILP (prev2))
+ if (NILP (prev2))
XWEAK_LIST (rest)->list = XCDR (rest2);
else
XCDR (prev2) = XCDR (rest2);
if (go_tortoise)
tortoise = XCDR (tortoise);
go_tortoise = !go_tortoise;
- if (GC_EQ (rest2, tortoise))
+ if (EQ (rest2, tortoise))
break;
}
}
if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */
if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC;
if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
+ if (EQ (symbol, Qfull_assoc)) return WEAK_LIST_FULL_ASSOC;
signal_simple_error ("Invalid weak list type", symbol);
return WEAK_LIST_SIMPLE; /* not reached */
case WEAK_LIST_ASSOC: return Qassoc;
case WEAK_LIST_KEY_ASSOC: return Qkey_assoc;
case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
+ case WEAK_LIST_FULL_ASSOC: return Qfull_assoc;
default:
- abort ();
+ ABORT ();
}
return Qnil; /* not reached */
Return a new weak list object of type TYPE.
A weak list object is an object that contains a list. This list behaves
like any other list except that its elements do not count towards
-garbage collection -- if the only pointer to an object in inside a weak
+garbage collection -- if the only pointer to an object is inside a weak
list (other than pointers in similar objects such as weak hash tables),
the object is garbage collected and automatically removed from the list.
This is used internally, for example, to manage the list holding the
and the car is not pointed to.
`value-assoc' Objects in the list disappear if they are conses
and the cdr is not pointed to.
+`full-assoc' Objects in the list disappear if they are conses
+ and neither the car nor the cdr is pointed to.
*/
(type))
{
void
init_errors_once_early (void)
{
- defsymbol (&Qerror_conditions, "error-conditions");
- defsymbol (&Qerror_message, "error-message");
+ DEFSYMBOL (Qerror_conditions);
+ DEFSYMBOL (Qerror_message);
/* We declare the errors here because some other deferrors depend
on some of the errors below. */
/* ERROR is used as a signaler for random errors for which nothing
else is right */
- deferror (&Qerror, "error", "error", Qnil);
- deferror (&Qquit, "quit", "Quit", Qnil);
+ DEFERROR (Qerror, "error", Qnil);
+ DEFERROR_STANDARD (Qquit, Qnil);
- deferror (&Qwrong_type_argument, "wrong-type-argument",
- "Wrong type argument", Qerror);
- deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range",
- Qerror);
- deferror (&Qvoid_function, "void-function",
- "Symbol's function definition is void", Qerror);
- deferror (&Qcyclic_function_indirection, "cyclic-function-indirection",
- "Symbol's chain of function indirections contains a loop", Qerror);
- deferror (&Qvoid_variable, "void-variable",
- "Symbol's value as variable is void", Qerror);
- deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection",
- "Symbol's chain of variable indirections contains a loop", Qerror);
- deferror (&Qsetting_constant, "setting-constant",
- "Attempt to set a constant symbol", Qerror);
- deferror (&Qinvalid_read_syntax, "invalid-read-syntax",
- "Invalid read syntax", Qerror);
+ DEFERROR (Qunimplemented, "Feature not yet implemented", Qerror);
+ DEFERROR_STANDARD (Qsyntax_error, Qerror);
+ DEFERROR_STANDARD (Qinvalid_read_syntax, Qsyntax_error);
+ DEFERROR_STANDARD (Qlist_formation_error, Qsyntax_error);
/* Generated by list traversal macros */
- deferror (&Qmalformed_list, "malformed-list",
- "Malformed list", Qerror);
- deferror (&Qmalformed_property_list, "malformed-property-list",
- "Malformed property list", Qmalformed_list);
- deferror (&Qcircular_list, "circular-list",
- "Circular list", Qerror);
- deferror (&Qcircular_property_list, "circular-property-list",
- "Circular property list", Qcircular_list);
-
- deferror (&Qinvalid_function, "invalid-function", "Invalid function",
- Qerror);
- deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments",
- "Wrong number of arguments", Qerror);
- deferror (&Qno_catch, "no-catch", "No catch for tag",
- Qerror);
- deferror (&Qbeginning_of_buffer, "beginning-of-buffer",
- "Beginning of buffer", Qerror);
- deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror);
- deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only",
- Qerror);
+ DEFERROR_STANDARD (Qmalformed_list, Qlist_formation_error);
+ DEFERROR_STANDARD (Qmalformed_property_list, Qmalformed_list);
+ DEFERROR_STANDARD (Qcircular_list, Qlist_formation_error);
+ DEFERROR_STANDARD (Qcircular_property_list, Qcircular_list);
- deferror (&Qio_error, "io-error", "IO Error", Qerror);
- deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
+ DEFERROR_STANDARD (Qinvalid_argument, Qerror);
+ DEFERROR_STANDARD (Qwrong_type_argument, Qinvalid_argument);
+ DEFERROR_STANDARD (Qargs_out_of_range, Qinvalid_argument);
+ DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument);
+ DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument);
+ DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument);
- deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror);
- deferror (&Qrange_error, "range-error", "Arithmetic range error",
- Qarith_error);
- deferror (&Qdomain_error, "domain-error", "Arithmetic domain error",
- Qarith_error);
- deferror (&Qsingularity_error, "singularity-error",
- "Arithmetic singularity error", Qdomain_error);
- deferror (&Qoverflow_error, "overflow-error",
- "Arithmetic overflow error", Qdomain_error);
- deferror (&Qunderflow_error, "underflow-error",
- "Arithmetic underflow error", Qdomain_error);
+ DEFERROR_STANDARD (Qinternal_error, Qerror);
+
+ DEFERROR (Qinvalid_state, "Properties or values have been set incorrectly",
+ Qerror);
+ DEFERROR (Qvoid_function, "Symbol's function definition is void",
+ Qinvalid_state);
+ DEFERROR (Qcyclic_function_indirection,
+ "Symbol's chain of function indirections contains a loop",
+ Qinvalid_state);
+ DEFERROR (Qvoid_variable, "Symbol's value as variable is void",
+ Qinvalid_state);
+ DEFERROR (Qcyclic_variable_indirection,
+ "Symbol's chain of variable indirections contains a loop",
+ Qinvalid_state);
+
+ DEFERROR (Qinvalid_operation,
+ "Operation not allowed or error during operation", Qerror);
+ DEFERROR (Qinvalid_change, "Attempt to set properties or values incorrectly",
+ Qinvalid_operation);
+ DEFERROR (Qsetting_constant, "Attempt to set a constant symbol",
+ Qinvalid_change);
+
+ DEFERROR (Qediting_error, "Invalid operation during editing",
+ Qinvalid_operation);
+ DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error);
+ DEFERROR_STANDARD (Qend_of_buffer, Qediting_error);
+ DEFERROR (Qbuffer_read_only, "Buffer is read-only", Qediting_error);
+
+ DEFERROR (Qio_error, "IO Error", Qinvalid_operation);
+ DEFERROR (Qend_of_file, "End of file or stream", Qio_error);
+
+ DEFERROR (Qarith_error, "Arithmetic error", Qinvalid_operation);
+ DEFERROR (Qrange_error, "Arithmetic range error", Qarith_error);
+ DEFERROR (Qdomain_error, "Arithmetic domain error", Qarith_error);
+ DEFERROR (Qsingularity_error, "Arithmetic singularity error", Qdomain_error);
+ DEFERROR (Qoverflow_error, "Arithmetic overflow error", Qdomain_error);
+ DEFERROR (Qunderflow_error, "Arithmetic underflow error", Qdomain_error);
}
void
syms_of_data (void)
{
- defsymbol (&Qcons, "cons");
- defsymbol (&Qkeyword, "keyword");
- defsymbol (&Qquote, "quote");
- defsymbol (&Qlambda, "lambda");
- defsymbol (&Qignore, "ignore");
- defsymbol (&Qlistp, "listp");
- defsymbol (&Qtrue_list_p, "true-list-p");
- defsymbol (&Qconsp, "consp");
- defsymbol (&Qsubrp, "subrp");
- defsymbol (&Qsymbolp, "symbolp");
- defsymbol (&Qkeywordp, "keywordp");
- defsymbol (&Qintegerp, "integerp");
- defsymbol (&Qcharacterp, "characterp");
- defsymbol (&Qnatnump, "natnump");
- defsymbol (&Qstringp, "stringp");
- defsymbol (&Qarrayp, "arrayp");
- defsymbol (&Qsequencep, "sequencep");
- defsymbol (&Qbufferp, "bufferp");
- defsymbol (&Qbitp, "bitp");
- defsymbol (&Qbit_vectorp, "bit-vector-p");
- defsymbol (&Qvectorp, "vectorp");
- defsymbol (&Qchar_or_string_p, "char-or-string-p");
- defsymbol (&Qmarkerp, "markerp");
- defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p");
- defsymbol (&Qinteger_or_char_p, "integer-or-char-p");
- defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p");
- defsymbol (&Qnumberp, "numberp");
- defsymbol (&Qnumber_or_marker_p, "number-or-marker-p");
- defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
- defsymbol (&Qcdr, "cdr");
- defsymbol (&Qweak_listp, "weak-list-p");
+ INIT_LRECORD_IMPLEMENTATION (weak_list);
+
+ DEFSYMBOL (Qquote);
+ DEFSYMBOL (Qlambda);
+ DEFSYMBOL (Qlistp);
+ DEFSYMBOL (Qtrue_list_p);
+ DEFSYMBOL (Qconsp);
+ DEFSYMBOL (Qsubrp);
+ DEFSYMBOL (Qsymbolp);
+ DEFSYMBOL (Qintegerp);
+ DEFSYMBOL (Qcharacterp);
+ DEFSYMBOL (Qnatnump);
+ DEFSYMBOL (Qstringp);
+ DEFSYMBOL (Qarrayp);
+ DEFSYMBOL (Qsequencep);
+ DEFSYMBOL (Qbufferp);
+ DEFSYMBOL (Qbitp);
+ DEFSYMBOL_MULTIWORD_PREDICATE (Qbit_vectorp);
+ DEFSYMBOL (Qvectorp);
+ DEFSYMBOL (Qchar_or_string_p);
+ DEFSYMBOL (Qmarkerp);
+ DEFSYMBOL (Qinteger_or_marker_p);
+ DEFSYMBOL (Qinteger_or_char_p);
+ DEFSYMBOL (Qinteger_char_or_marker_p);
+ DEFSYMBOL (Qnumberp);
+ DEFSYMBOL (Qnumber_char_or_marker_p);
+ DEFSYMBOL (Qcdr);
+ DEFSYMBOL_MULTIWORD_PREDICATE (Qweak_listp);
#ifdef LISP_FLOAT_TYPE
- defsymbol (&Qfloatp, "floatp");
+ DEFSYMBOL (Qfloatp);
#endif /* LISP_FLOAT_TYPE */
DEFSUBR (Fwrong_type_argument);
DEFSUBR (Fchar_to_int);
DEFSUBR (Fint_to_char);
DEFSUBR (Fchar_or_char_int_p);
+ DEFSUBR (Fchar_ref_p);
DEFSUBR (Fintegerp);
DEFSUBR (Finteger_or_marker_p);
DEFSUBR (Finteger_or_char_p);
{
/* This must not be staticpro'd */
Vall_weak_lists = Qnil;
+ dump_add_weak_object_chain (&Vall_weak_lists);
#ifdef DEBUG_XEMACS
DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
projects / chise / xemacs-chise.git.1 / blobdiff