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;
-#ifdef LISP_FLOAT_TYPE
Lisp_Object Qfloatp;
-#endif
#ifdef DEBUG_XEMACS
int debug_ebola_backtrace_length;
-#if 0
-/*#ifndef LRECORD_SYMBOL*/
-#include "backtrace.h"
-#endif
-
int
eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2)
{
- if (debug_issue_ebola_notices != -42 /* abracadabra */ &&
- (((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1)))
- && (debug_issue_ebola_notices >= 2
- || XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2))))
+ if (debug_issue_ebola_notices
+ && ((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. */
write_c_string ("Comparison between integer and character is constant nil (",
Qexternal_debugging_output);
Fprinc (obj1, Qexternal_debugging_output);
}
DOESNT_RETURN
-pure_write_error (Lisp_Object obj)
+c_write_error (Lisp_Object obj)
+{
+ signal_simple_error ("Attempt to modify read-only object (c)", obj);
+}
+
+DOESNT_RETURN
+lisp_write_error (Lisp_Object obj)
{
- signal_simple_error ("Attempt to modify read-only object", obj);
+ signal_simple_error ("Attempt to modify read-only object (lisp)", obj);
}
DOESNT_RETURN
}
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)))
{
switch (XTYPE (object))
{
-#ifndef LRECORD_CONS
- case Lisp_Type_Cons: return Qcons;
-#endif
-
-#ifndef LRECORD_SYMBOL
- case Lisp_Type_Symbol: return Qsymbol;
-#endif
-
-#ifndef LRECORD_STRING
- case Lisp_Type_String: return Qstring;
-#endif
-
-#ifndef LRECORD_VECTOR
- case Lisp_Type_Vector: return Qvector;
-#endif
-
case Lisp_Type_Record:
return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name);
if (!CONSP (conscell))
conscell = wrong_type_argument (Qconsp, conscell);
- CHECK_IMPURE (conscell);
XCAR (conscell) = newcar;
return newcar;
}
if (!CONSP (conscell))
conscell = wrong_type_argument (Qconsp, conscell);
- CHECK_IMPURE (conscell);
XCDR (conscell) = newcdr;
return newcdr;
}
}
if (errorp && UNBOUNDP (hare))
- signal_void_function_error (object);
+ 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_IMPURE (array);
-
if (VECTORP (array))
{
if (idx >= XVECTOR_LENGTH (array)) goto range_error;
int int_p;
union
{
- int ival;
+ EMACS_INT ival;
double dval;
} c;
} int_or_double;
}
}
-static int
+static EMACS_INT
integer_char_or_marker_to_int (Lisp_Object obj)
{
retry:
p++;
#ifdef LISP_FLOAT_TYPE
- if (isfloat_string (p))
+ if (isfloat_string (p) && b == 10)
return make_float (atof (p));
#endif /* LISP_FLOAT_TYPE */
*/
(num1, num2))
{
- 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 (num1);
+ EMACS_INT ival2 = integer_char_or_marker_to_int (num2);
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 */
}
{
Lisp_Object result;
struct weak_list *wl =
- alloc_lcrecord_type (struct weak_list, lrecord_weak_list);
+ alloc_lcrecord_type (struct weak_list, &lrecord_weak_list);
wl->list = Qnil;
wl->type = type;
return result;
}
+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_END }
+};
+
DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
mark_weak_list, print_weak_list,
0, weak_list_equal, weak_list_hash,
+ weak_list_description,
struct weak_list);
/*
-- we do not mark the list elements (either the elements themselves
*/
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 (obj_marked_p (XCDR (elem)))
+ else if (marked_p (XCDR (elem)))
{
need_to_mark_cons = 1;
/* We still need to mark elem and XCAR (elem);
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;
}
}
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 (&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");
{
/* This must not be staticpro'd */
Vall_weak_lists = Qnil;
+ pdump_wire_list (&Vall_weak_lists);
#ifdef DEBUG_XEMACS
- DEFVAR_INT ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
+ DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
If non-zero, note when your code may be suffering from char-int confoundance.
That is to say, if XEmacs encounters a usage of `eq', `memq', `equal',
etc. where an int and a char with the same value are being compared,
impossible to accurately determine Ebola infection.
*/ );
- debug_issue_ebola_notices = 2; /* #### temporary hack */
+ debug_issue_ebola_notices = 0;
DEFVAR_INT ("debug-ebola-backtrace-length",
&debug_ebola_backtrace_length /*
projects / chise / xemacs-chise.git- / blobdiff