/* 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.
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
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;
Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
Lisp_Object Qconsp, Qsubrp;
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 ("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.
}
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);
- 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);
- 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;
}
\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))
{
- EMACS_INT ival1 = integer_char_or_marker_to_int (num1);
- EMACS_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);
}
static const struct lrecord_description weak_list_description[] = {
- { XD_LISP_OBJECT, offsetof(struct weak_list, list), 1 },
- { XD_LO_LINK, offsetof(struct weak_list, next_weak) },
+ { XD_LISP_OBJECT, offsetof (struct weak_list, list) },
+ { XD_LO_LINK, offsetof (struct weak_list, next_weak) },
{ XD_END }
};
}
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 (marked_p (XCAR (elem)) ||
+ 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;
+
default:
abort ();
}
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 ();
}
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_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 (&Qio_error, "io-error", "IO Error", Qerror);
- deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
+ DEFERROR_STANDARD (Qinternal_error, Qerror);
- 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 (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 (&Qquote, "quote");
- defsymbol (&Qlambda, "lambda");
- defsymbol (&Qlistp, "listp");
- defsymbol (&Qtrue_list_p, "true-list-p");
- defsymbol (&Qconsp, "consp");
- defsymbol (&Qsubrp, "subrp");
- defsymbol (&Qsymbolp, "symbolp");
- 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_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);
{
/* This must not be staticpro'd */
Vall_weak_lists = Qnil;
- pdump_wire_list (&Vall_weak_lists);
+ dump_add_weak_object_chain (&Vall_weak_lists);
#ifdef DEBUG_XEMACS
DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*