X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fdata.c;h=d4792d2f84bb3f9124e25465f5600e89a43765b7;hb=2cbece6401b2279497293e6dc54cda607f49db2f;hp=4e4a274ab8963dc16139c3931a08484ff80ac103;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921;p=chise%2Fxemacs-chise.git- diff --git a/src/data.c b/src/data.c index 4e4a274..d4792d2 100644 --- a/src/data.c +++ b/src/data.c @@ -50,18 +50,16 @@ 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; -#ifdef LISP_FLOAT_TYPE Lisp_Object Qfloatp; -#endif #ifdef DEBUG_XEMACS @@ -69,19 +67,14 @@ int debug_issue_ebola_notices; 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 @@ PREDICATE. At that point, the gotten value is returned. } 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 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) } 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 @@ EMACS_INT sign_extend_temp; /* 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 @@ If non-nil, the return value will be a list whose first element is */ (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 @@ Return a symbol representing the type of OBJECT. { 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 @@ Set the car of CONSCELL to be NEWCAR. Return NEWCAR. if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCAR (conscell) = newcar; return newcar; } @@ -645,7 +627,6 @@ Set the cdr of CONSCELL to be NEWCDR. Return NEWCDR. if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCDR (conscell) = newcdr; return newcdr; } @@ -679,7 +660,7 @@ indirect_function (Lisp_Object object, int errorp) } if (errorp && UNBOUNDP (hare)) - signal_void_function_error (object); + return signal_void_function_error (object); return hare; } @@ -706,7 +687,7 @@ ARRAY may be a vector, bit vector, or string. INDEX starts at 0. */ (array, index_)) { - int idx; + EMACS_INT idx; retry: @@ -760,7 +741,7 @@ ARRAY may be a vector, bit vector, or string. INDEX starts at 0. */ (array, index_, newval)) { - int idx; + EMACS_INT idx; retry: @@ -774,8 +755,6 @@ ARRAY may be a vector, bit vector, or string. INDEX starts at 0. if (idx < 0) goto range_error; - CHECK_IMPURE (array); - if (VECTORP (array)) { if (idx >= XVECTOR_LENGTH (array)) goto range_error; @@ -791,7 +770,7 @@ ARRAY may be a vector, bit vector, or string. INDEX starts at 0. { CHECK_CHAR_COERCE_INT (newval); if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error; - set_string_char (XSTRING (array), idx, XCHAR (newval)); + set_string_char (XSTRING (array), idx, (unsigned char) XCHAR (newval)); bump_string_modiff (array); } else @@ -816,7 +795,7 @@ typedef struct int int_p; union { - int ival; + EMACS_INT ival; double dval; } c; } int_or_double; @@ -856,7 +835,7 @@ number_char_or_marker_to_double (Lisp_Object obj) } } -static int +static EMACS_INT integer_char_or_marker_to_int (Lisp_Object obj) { retry: @@ -1085,7 +1064,7 @@ Floating point numbers always use base 10. p++; #ifdef LISP_FLOAT_TYPE - if (isfloat_string (p)) + if (isfloat_string (p) && b == 10) return make_float (atof (p)); #endif /* LISP_FLOAT_TYPE */ @@ -1433,8 +1412,8 @@ Both must be integers, characters or markers. */ (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 @@ If either argument is a float, a float will be returned. } #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 Vall_weak_lists; /* Gemarke es nicht!!! */ 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 @@ make_weak_list (enum weak_list_type type) { 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 @@ make_weak_list (enum weak_list_type type) 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 @@ DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list, */ 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), /* 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), (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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), /* 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 @@ finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), } 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 @@ prune_weak_lists (int (*obj_marked_p) (Lisp_Object)) /* 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 @@ prune_weak_lists (int (*obj_marked_p) (Lisp_Object)) 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 @@ prune_weak_lists (int (*obj_marked_p) (Lisp_Object)) if (go_tortoise) tortoise = XCDR (tortoise); go_tortoise = !go_tortoise; - if (GC_EQ (rest2, tortoise)) + if (EQ (rest2, tortoise)) break; } } @@ -2091,17 +2076,15 @@ init_errors_once_early (void) void syms_of_data (void) { - defsymbol (&Qcons, "cons"); - defsymbol (&Qkeyword, "keyword"); + INIT_LRECORD_IMPLEMENTATION (weak_list); + 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 +2101,6 @@ syms_of_data (void) 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 +2199,10 @@ vars_of_data (void) { /* 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 +2216,7 @@ have its chars and ints all confounded in the byte code, making it 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 /*