xemacs-beta: src/data.c comparison

comparison src/data.c @ 424:11054d720c21 r21-2-20

Import from CVS: tag r21-2-20

author	cvs
date	Mon, 13 Aug 2007 11:26:11 +0200
parents	41dbb7a9d5f2
children

comparison

equal deleted inserted replaced

-:28d9c139be4c
+:11054d720c21
 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
 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 Qnumberp, Qnumber_char_or_marker_p;
-Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore;
+Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
 Lisp_Object Qfloatp;
 #ifdef DEBUG_XEMACS
 {
 signal_error (Qargs_out_of_range, list3 (a1, a2, 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));
 }
 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);
+EMACS_INT sign_extend_lisp_int (EMACS_INT num);
-int
+EMACS_INT
 sign_extend_lisp_int (EMACS_INT num)
 {
 if (num & (1L << (VALBITS - 1)))
 return num | ((-1L) << VALBITS);
 else
 (conscell, newcar))
 {
 if (!CONSP (conscell))
 conscell = wrong_type_argument (Qconsp, conscell);
-CHECK_LISP_WRITEABLE (conscell);
 XCAR (conscell) = newcar;
 return newcar;
 }
 DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
 (conscell, newcdr))
 {
 if (!CONSP (conscell))
 conscell = wrong_type_argument (Qconsp, conscell);
-CHECK_LISP_WRITEABLE (conscell);
 XCDR (conscell) = newcdr;
 return newcdr;
 }
 /* Find the function at the end of a chain of symbol function indirections.
 Return the element of ARRAY at index INDEX.
 ARRAY may be a vector, bit vector, or string.  INDEX starts at 0.
 */
 (array, index_))
 {
-int idx;
+EMACS_INT idx;
 retry:
 if      (INTP  (index_)) idx = XINT  (index_);
 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
 Store into the element of ARRAY at index INDEX the value NEWVAL.
 ARRAY may be a vector, bit vector, or string.  INDEX starts at 0.
 */
 (array, index_, newval))
 {
-int idx;
+EMACS_INT idx;
 retry:
 if      (INTP  (index_)) idx = XINT (index_);
 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
 index_ = wrong_type_argument (Qinteger_or_char_p, index_);
 goto retry;
 }
 if (idx < 0) goto range_error;
-CHECK_LISP_WRITEABLE (array);
 if (VECTORP (array))
 {
 if (idx >= XVECTOR_LENGTH (array)) goto range_error;
 XVECTOR_DATA (array)[idx] = newval;
 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
 goto retry;
 }
 }
-static int
+static EMACS_INT
 integer_char_or_marker_to_int (Lisp_Object obj)
 {
 retry:
 if      (INTP    (obj)) return XINT  (obj);
 else if (CHARP   (obj)) return XCHAR (obj);
 Return remainder of first arg divided by second.
 Both must be integers, characters or markers.
 */
 (num1, num2))
 {
-int ival1 = integer_char_or_marker_to_int (num1);
+EMACS_INT ival1 = integer_char_or_marker_to_int (num1);
-int ival2 = integer_char_or_marker_to_int (num2);
+EMACS_INT ival2 = integer_char_or_marker_to_int (num2);
 if (ival2 == 0)
 Fsignal (Qarith_error, Qnil);
 return make_int (ival1 % ival2);
 return make_float (dval1);
 }
 #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;
 /* If the "remainder" comes out with the wrong sign, fix it.  */
 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 */
 }
 static void
 return result;
 }
 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_LO_LINK,     offsetof(struct weak_list, next_weak) },
 { XD_END }
 };
 DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
 			       mark_weak_list, print_weak_list,
 Linked lists just majorly suck, d'ya know?
 */
 int
-finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
+finish_marking_weak_lists (void)
-			   void (*markobj) (Lisp_Object))
 {
 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;
 for (rest2 = XWEAK_LIST (rest)->list;
 	   /* 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;
 	  /* If the element is "marked" (meaning depends on the type
 	     of weak list), we need to mark the cons containing the
 	  /* If a cons is already marked, then its car is already marked
 	     (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)) &&
+	      else if (marked_p (XCAR (elem)) &&
-		       obj_marked_p (XCDR (elem)))
+		       marked_p (XCDR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem, because it's
 		     probably not marked. */
 		  need_to_mark_elem = 1;
 		}
 	      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);
 		     marking elem does both */
 		  need_to_mark_elem = 1;
 		}
 	      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);
 		     marking elem does both */
 		  need_to_mark_elem = 1;
 	    default:
 	      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);
+	      Lisp_Cons *c = XCONS (rest2);
-	      if (!CONS_MARKED_P (ptr))
+	      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;
 	}
 }
 return did_mark;
 }
 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 =
 	      XWEAK_LIST (rest)->next_weak;
 	}
 for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2;
 	       /* 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:
 		 -- if the cons is pointed to somewhere else,
 		    then it should stay around and will be marked.
 		 -- otherwise, if it should stay around, it will
 		    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);
 		  rest2 = XCDR (rest2);
 		  /* Ouch.  Circularity checking is even trickier
 		  rest2 = XCDR (rest2);
 		  if (go_tortoise)
 		    tortoise = XCDR (tortoise);
 		  go_tortoise = !go_tortoise;
-		  if (GC_EQ (rest2, tortoise))
+		  if (EQ (rest2, tortoise))
 		    break;
 		}
 	    }
 	  prev = rest;
 }
 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 (&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");
 #ifdef LISP_FLOAT_TYPE
 void
 vars_of_data (void)
 {
 /* This must not be staticpro'd */
 Vall_weak_lists = Qnil;
+pdump_wire_list (&Vall_weak_lists);
 #ifdef DEBUG_XEMACS
 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',

Mercurial > hg > xemacs-beta

comparison src/data.c @ 424:11054d720c21 r21-2-20