Mercurial > hg > xemacs-beta
diff src/data.c @ 398:74fd4e045ea6 r21-2-29
Import from CVS: tag r21-2-29
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:13:30 +0200 |
parents | 8626e4521993 |
children | a86b2b5e0111 |
line wrap: on
line diff
--- a/src/data.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/data.c Mon Aug 13 11:13:30 2007 +0200 @@ -50,18 +50,16 @@ 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 @@ -69,19 +67,14 @@ 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); @@ -130,9 +123,15 @@ } DOESNT_RETURN -pure_write_error (Lisp_Object obj) +c_write_error (Lisp_Object obj) { - signal_simple_error ("Attempt to modify read-only 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 (lisp)", obj); } DOESNT_RETURN @@ -148,7 +147,7 @@ } 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)); @@ -161,8 +160,8 @@ /* 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))) @@ -358,7 +357,7 @@ */ (subr)) { - CONST char *prompt; + const char *prompt; CHECK_SUBR (subr); prompt = XSUBR (subr)->prompt; return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil; @@ -546,22 +545,6 @@ { 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); @@ -632,7 +615,6 @@ if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCAR (conscell) = newcar; return newcar; } @@ -645,7 +627,6 @@ if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCDR (conscell) = newcdr; return newcdr; } @@ -679,7 +660,7 @@ } if (errorp && UNBOUNDP (hare)) - signal_void_function_error (object); + return signal_void_function_error (object); return hare; } @@ -706,7 +687,7 @@ */ (array, index_)) { - int idx; + EMACS_INT idx; retry: @@ -760,7 +741,7 @@ */ (array, index_, newval)) { - int idx; + EMACS_INT idx; retry: @@ -774,8 +755,6 @@ if (idx < 0) goto range_error; - CHECK_IMPURE (array); - if (VECTORP (array)) { if (idx >= XVECTOR_LENGTH (array)) goto range_error; @@ -816,7 +795,7 @@ int int_p; union { - int ival; + EMACS_INT ival; double dval; } c; } int_or_double; @@ -856,7 +835,7 @@ } } -static int +static EMACS_INT integer_char_or_marker_to_int (Lisp_Object obj) { retry: @@ -1433,8 +1412,8 @@ */ (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); @@ -1485,7 +1464,7 @@ } #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; @@ -1587,7 +1566,7 @@ 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 */ } @@ -1630,7 +1609,7 @@ { 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; @@ -1640,9 +1619,16 @@ return result; } +static const struct lrecord_description weak_list_description[] = { + { XD_LISP_OBJECT, offsetof (struct weak_list, list) }, + { 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 @@ -1662,20 +1648,19 @@ */ 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; @@ -1683,7 +1668,7 @@ /* 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; @@ -1698,7 +1683,7 @@ (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); @@ -1706,19 +1691,19 @@ 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 @@ -1728,13 +1713,13 @@ 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); @@ -1744,13 +1729,13 @@ 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); @@ -1763,23 +1748,23 @@ 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; } } @@ -1787,9 +1772,9 @@ /* 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; } } @@ -1798,18 +1783,18 @@ } 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 = @@ -1825,7 +1810,7 @@ /* 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: @@ -1836,10 +1821,10 @@ 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); @@ -1880,7 +1865,7 @@ if (go_tortoise) tortoise = XCDR (tortoise); go_tortoise = !go_tortoise; - if (GC_EQ (rest2, tortoise)) + if (EQ (rest2, tortoise)) break; } } @@ -2091,17 +2076,13 @@ 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"); @@ -2118,7 +2099,6 @@ 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"); @@ -2217,9 +2197,10 @@ { /* 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, @@ -2233,7 +2214,7 @@ 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 /*